base 4.1.0.0 → 4.2.0.0
raw patch · 128 files changed
+9969/−5350 lines, 128 filesdep +integer-gmpdep +integer-simpledep −integer
Dependencies added: integer-gmp, integer-simple
Dependencies removed: integer
Files
- Control/Applicative.hs +39/−32
- Control/Arrow.hs +0/−1
- Control/Category.hs +0/−1
- Control/Concurrent.hs +7/−9
- Control/Concurrent/MVar.hs +1/−1
- Control/Concurrent/QSem.hs +7/−4
- Control/Concurrent/QSemN.hs +7/−4
- Control/Concurrent/SampleVar.hs +2/−3
- Control/Exception.hs +3/−3
- Control/Exception/Base.hs +23/−24
- Control/Monad/ST.hs +1/−3
- Control/Monad/ST/Lazy.hs +0/−2
- Control/Monad/ST/Strict.hs +0/−1
- Control/OldException.hs +17/−15
- Data/Bits.hs +5/−6
- Data/Data.hs +68/−37
- Data/Dynamic.hs +6/−1
- Data/Fixed.hs +101/−60
- Data/Foldable.hs +1/−0
- Data/Functor.hs +28/−0
- Data/HashTable.hs +11/−27
- Data/IORef.hs +4/−2
- Data/Ix.hs +1/−1
- Data/List.hs +14/−0
- Data/Monoid.hs +22/−10
- Data/STRef/Lazy.hs +1/−0
- Data/STRef/Strict.hs +0/−1
- Data/Tuple.hs +4/−0
- Data/Typeable.hs +8/−4
- Data/Typeable.hs-boot +0/−2
- Foreign/C/Error.hs +10/−5
- Foreign/C/String.hs +0/−1
- Foreign/C/Types.hs +14/−5
- Foreign/Concurrent.hs +4/−5
- Foreign/ForeignPtr.hs +5/−8
- Foreign/Marshal/Alloc.hs +5/−2
- Foreign/Marshal/Array.hs +0/−1
- Foreign/Marshal/Error.hs +2/−1
- Foreign/Marshal/Pool.hs +3/−3
- Foreign/Marshal/Utils.hs +2/−3
- Foreign/Ptr.hs +1/−2
- Foreign/Storable.hs +1/−1
- Foreign/Storable.hs-boot +0/−22
- GHC/Arr.lhs +17/−14
- GHC/Base.lhs +68/−22
- GHC/Conc.lhs +174/−221
- GHC/ConsoleHandler.hs +22/−18
- GHC/Constants.hs +9/−0
- GHC/Desugar.hs +7/−2
- GHC/Enum.lhs +13/−13
- GHC/Err.lhs-boot +20/−0
- GHC/Exception.lhs +1/−1
- GHC/Exts.hs +14/−2
- GHC/Float.lhs +22/−22
- GHC/ForeignPtr.hs +6/−5
- GHC/Handle.hs +55/−1843
- GHC/Handle.hs-boot +0/−9
- GHC/IO.hs +339/−974
- GHC/IO.hs-boot +5/−0
- GHC/IO/Buffer.hs +287/−0
- GHC/IO/BufferedIO.hs +127/−0
- GHC/IO/Device.hs +152/−0
- GHC/IO/Encoding.hs +155/−0
- GHC/IO/Encoding/CodePage.hs +158/−0
- GHC/IO/Encoding/CodePage/Table.hs +430/−0
- GHC/IO/Encoding/Iconv.hs +227/−0
- GHC/IO/Encoding/Latin1.hs +136/−0
- GHC/IO/Encoding/Types.hs +89/−0
- GHC/IO/Encoding/UTF16.hs +342/−0
- GHC/IO/Encoding/UTF32.hs +306/−0
- GHC/IO/Encoding/UTF8.hs +342/−0
- GHC/IO/Exception.hs +336/−0
- GHC/IO/Exception.hs-boot +12/−0
- GHC/IO/FD.hs +633/−0
- GHC/IO/Handle.hs +734/−0
- GHC/IO/Handle.hs-boot +8/−0
- GHC/IO/Handle/FD.hs +271/−0
- GHC/IO/Handle/FD.hs-boot +7/−0
- GHC/IO/Handle/Internals.hs +806/−0
- GHC/IO/Handle/Text.hs +987/−0
- GHC/IO/Handle/Types.hs +402/−0
- GHC/IO/IOMode.hs +26/−0
- GHC/IOArray.hs +69/−0
- GHC/IOBase.hs +91/−0
- GHC/IOBase.lhs +0/−1040
- GHC/IORef.hs +49/−0
- GHC/Int.hs +12/−11
- GHC/List.lhs +1/−1
- GHC/MVar.hs +143/−0
- GHC/Num.lhs +4/−2
- GHC/PArr.hs +1/−1
- GHC/Pack.lhs +0/−1
- GHC/Ptr.lhs +0/−3
- GHC/Real.lhs +8/−1
- GHC/Show.lhs +1/−1
- GHC/Show.lhs-boot +10/−0
- GHC/Stable.lhs +1/−1
- GHC/Storable.lhs +0/−1
- GHC/TopHandler.lhs +17/−8
- GHC/Weak.lhs +1/−2
- GHC/Word.hs +21/−15
- Prelude.hs +9/−30
- Prelude.hs-boot +0/−7
- System/CPUTime.hsc +38/−5
- System/Environment.hs +5/−3
- System/Exit.hs +9/−3
- System/IO.hs +88/−11
- System/IO/Error.hs +104/−35
- System/IO/Unsafe.hs +1/−1
- System/Mem/StableName.hs +1/−1
- System/Mem/Weak.hs +1/−1
- System/Posix/Internals.hs +96/−85
- System/Posix/Types.hs +2/−2
- System/Timeout.hs +1/−0
- Text/ParserCombinators/ReadP.hs +19/−8
- Text/Printf.hs +19/−14
- Text/Read/Lex.hs +10/−10
- aclocal.m4 +38/−59
- base.cabal +48/−8
- cbits/PrelIOUtils.c +10/−1
- cbits/dirUtils.c +0/−72
- cbits/iconv.c +25/−0
- cbits/primFloat.c +261/−0
- configure +457/−258
- configure.ac +44/−7
- include/HsBase.h +67/−148
- include/HsBaseConfig.h +14/−23
- include/dirUtils.h +0/−11
Control/Applicative.hs view
@@ -30,23 +30,22 @@ -- * Instances Const(..), WrappedMonad(..), WrappedArrow(..), ZipList(..), -- * Utility functions- (<$>), (<$), (*>), (<*), (<**>),+ (<$>), (<$), (<**>), liftA, liftA2, liftA3,- optional, some, many+ optional, ) where import Prelude hiding (id,(.))-import qualified Prelude import Control.Category import Control.Arrow (Arrow(arr, (&&&)), ArrowZero(zeroArrow), ArrowPlus((<+>))) import Control.Monad (liftM, ap, MonadPlus(..)) import Control.Monad.Instances ()+import Data.Functor ((<$>), (<$)) import Data.Monoid (Monoid(..)) infixl 3 <|>-infixl 4 <$>, <$ infixl 4 <*>, <*, *>, <**> -- | A functor with application.@@ -65,6 +64,12 @@ -- [/interchange/] -- @u '<*>' 'pure' y = 'pure' ('$' y) '<*>' u@ --+-- [/ignore left value/]+-- @u '*>' v = 'pure' ('const' 'id') '<*>' u '<*>' v@+--+-- [/ignore right value/]+-- @u '<*' v = 'pure' 'const' '<*>' u '<*>' v@+-- -- The 'Functor' instance should satisfy -- -- @@@ -72,6 +77,8 @@ -- @ -- -- If @f@ is also a 'Monad', define @'pure' = 'return'@ and @('<*>') = 'ap'@.+--+-- Minimal complete definition: 'pure' and '<*>'. class Functor f => Applicative f where -- | Lift a value.@@ -80,13 +87,41 @@ -- | Sequential application. (<*>) :: f (a -> b) -> f a -> f b + -- | Sequence actions, discarding the value of the first argument.+ (*>) :: f a -> f b -> f b+ (*>) = liftA2 (const id)++ -- | Sequence actions, discarding the value of the second argument.+ (<*) :: f a -> f b -> f a+ (<*) = liftA2 const+ -- | A monoid on applicative functors.+--+-- Minimal complete definition: 'empty' and '<|>'.+--+-- 'some' and 'many' should be the least solutions of the equations:+--+-- * @some v = (:) '<$>' v '<*>' many v@+--+-- * @many v = some v '<|>' 'pure' []@ class Applicative f => Alternative f where -- | The identity of '<|>' empty :: f a -- | An associative binary operation (<|>) :: f a -> f a -> f a + -- | One or more.+ some :: f a -> f [a]+ some v = some_v+ where many_v = some_v <|> pure []+ some_v = (:) <$> v <*> many_v++ -- | Zero or more.+ many :: f a -> f [a]+ many v = many_v+ where many_v = some_v <|> pure []+ some_v = (:) <$> v <*> many_v+ -- instances for Prelude types instance Applicative Maybe where@@ -170,22 +205,6 @@ -- extra functions --- | A synonym for 'fmap'.-(<$>) :: Functor f => (a -> b) -> f a -> f b-f <$> a = fmap f a---- | Replace the value.-(<$) :: Functor f => a -> f b -> f a-(<$) = (<$>) . const- --- | Sequence actions, discarding the value of the first argument.-(*>) :: Applicative f => f a -> f b -> f b-(*>) = liftA2 (const id)- --- | Sequence actions, discarding the value of the second argument.-(<*) :: Applicative f => f a -> f b -> f a-(<*) = liftA2 const- -- | A variant of '<*>' with the arguments reversed. (<**>) :: Applicative f => f a -> f (a -> b) -> f b (<**>) = liftA2 (flip ($))@@ -206,15 +225,3 @@ -- | One or none. optional :: Alternative f => f a -> f (Maybe a) optional v = Just <$> v <|> pure Nothing---- | One or more.-some :: Alternative f => f a -> f [a]-some v = some_v- where many_v = some_v <|> pure []- some_v = (:) <$> v <*> many_v---- | Zero or more.-many :: Alternative f => f a -> f [a]-many v = many_v- where many_v = some_v <|> pure []- some_v = (:) <$> v <*> many_v
Control/Arrow.hs view
@@ -39,7 +39,6 @@ ) where import Prelude hiding (id,(.))-import qualified Prelude import Control.Monad import Control.Monad.Fix
Control/Category.hs view
@@ -12,7 +12,6 @@ module Control.Category where -import Prelude hiding (id,(.)) import qualified Prelude infixr 9 .
Control/Concurrent.hs view
@@ -100,9 +100,8 @@ import GHC.Conc ( ThreadId(..), myThreadId, killThread, yield, threadDelay, forkIO, childHandler ) import qualified GHC.Conc-import GHC.IOBase ( IO(..) )-import GHC.IOBase ( unsafeInterleaveIO )-import GHC.IOBase ( newIORef, readIORef, writeIORef )+import GHC.IO ( IO(..), unsafeInterleaveIO )+import GHC.IORef ( newIORef, readIORef, writeIORef ) import GHC.Base import System.Posix.Types ( Fd )@@ -113,7 +112,6 @@ #ifdef mingw32_HOST_OS import Foreign.C import System.IO-import GHC.Handle #endif #endif @@ -432,7 +430,7 @@ if bound then do mv <- newEmptyMVar- forkIO (Exception.try action >>= putMVar mv)+ _ <- forkIO (Exception.try action >>= putMVar mv) takeMVar mv >>= \ei -> case ei of Left exception -> Exception.throw (exception :: SomeException) Right result -> return result@@ -455,7 +453,8 @@ -- and this only works with -threaded. | threaded = withThread (waitFd fd 0) | otherwise = case fd of- 0 -> do hWaitForInput stdin (-1); return ()+ 0 -> do _ <- hWaitForInput stdin (-1)+ return () -- hWaitForInput does work properly, but we can only -- do this for stdin since we know its FD. _ -> error "threadWaitRead requires -threaded on Windows, or use System.IO.hWaitForInput"@@ -480,7 +479,7 @@ withThread :: IO a -> IO a withThread io = do m <- newEmptyMVar- forkIO $ try io >>= putMVar m+ _ <- forkIO $ try io >>= putMVar m x <- takeMVar m case x of Right a -> return a@@ -488,9 +487,8 @@ waitFd :: Fd -> CInt -> IO () waitFd fd write = do- throwErrnoIfMinus1 "fdReady" $+ throwErrnoIfMinus1_ "fdReady" $ fdReady (fromIntegral fd) write (fromIntegral iNFINITE) 0- return () iNFINITE :: CInt iNFINITE = 0xFFFFFFFF -- urgh
Control/Concurrent/MVar.hs view
@@ -40,7 +40,7 @@ #endif #ifdef __GLASGOW_HASKELL__-import GHC.Conc ( MVar, newEmptyMVar, newMVar, takeMVar, putMVar,+import GHC.MVar ( MVar, newEmptyMVar, newMVar, takeMVar, putMVar, tryTakeMVar, tryPutMVar, isEmptyMVar, addMVarFinalizer ) #endif
Control/Concurrent/QSem.hs view
@@ -39,11 +39,14 @@ INSTANCE_TYPEABLE0(QSem,qSemTc,"QSem") --- |Build a new 'QSem'+-- |Build a new 'QSem' with a supplied initial quantity.+-- The initial quantity must be at least 0. newQSem :: Int -> IO QSem-newQSem initial = do- sem <- newMVar (initial, [])- return (QSem sem)+newQSem initial =+ if initial < 0+ then fail "newQSem: Initial quantity must be non-negative"+ else do sem <- newMVar (initial, [])+ return (QSem sem) -- |Wait for a unit to become available waitQSem :: QSem -> IO ()
Control/Concurrent/QSemN.hs view
@@ -35,10 +35,13 @@ INSTANCE_TYPEABLE0(QSemN,qSemNTc,"QSemN") -- |Build a new 'QSemN' with a supplied initial quantity.-newQSemN :: Int -> IO QSemN -newQSemN initial = do- sem <- newMVar (initial, [])- return (QSemN sem)+-- The initial quantity must be at least 0.+newQSemN :: Int -> IO QSemN+newQSemN initial =+ if initial < 0+ then fail "newQSemN: Initial quantity must be non-negative"+ else do sem <- newMVar (initial, [])+ return (QSemN sem) -- |Wait for the specified quantity to become available waitQSemN :: QSemN -> Int -> IO ()
Control/Concurrent/SampleVar.hs view
@@ -61,8 +61,7 @@ -- |Build a 'SampleVar' with an initial value. newSampleVar :: a -> IO (SampleVar a) newSampleVar a = do- v <- newEmptyMVar- putMVar v a+ v <- newMVar a newMVar (1,v) -- |If the SampleVar is full, leave it empty. Otherwise, do nothing.@@ -70,7 +69,7 @@ emptySampleVar v = do (readers, var) <- takeMVar v if readers > 0 then do- takeMVar var+ _ <- takeMVar var putMVar v (0,var) else putMVar v (readers,var)
Control/Exception.hs view
@@ -53,8 +53,8 @@ System.ExitCode(), -- instance Exception #endif - BlockedOnDeadMVar(..),- BlockedIndefinitely(..),+ BlockedIndefinitelyOnMVar(..),+ BlockedIndefinitelyOnSTM(..), Deadlock(..), NoMethodError(..), PatternMatchFail(..),@@ -138,7 +138,7 @@ #ifdef __GLASGOW_HASKELL__ import GHC.Base-import GHC.IOBase+-- import GHC.IO hiding ( onException, finally ) import Data.Maybe #else import Prelude hiding (catch)
Control/Exception/Base.hs view
@@ -37,8 +37,8 @@ NestedAtomically(..), #endif - BlockedOnDeadMVar(..),- BlockedIndefinitely(..),+ BlockedIndefinitelyOnMVar(..),+ BlockedIndefinitelyOnSTM(..), Deadlock(..), NoMethodError(..), PatternMatchFail(..),@@ -106,10 +106,11 @@ #ifdef __GLASGOW_HASKELL__ import GHC.Base-import GHC.IOBase+import GHC.IO hiding (finally,onException)+import GHC.IO.Exception+import GHC.Exception import GHC.Show-import GHC.IOBase-import GHC.Exception hiding ( Exception )+-- import GHC.Exception hiding ( Exception ) import GHC.Conc #endif @@ -128,9 +129,8 @@ import Data.Maybe #ifdef __NHC__-import qualified System.IO.Error as H'98 (catch)-import System.IO.Error (ioError)-import IO (bracket)+import qualified IO as H'98 (catch)+import IO (bracket,ioError) import DIOError -- defn of IOError type import System (ExitCode()) import System.IO.Unsafe (unsafePerformIO)@@ -189,8 +189,8 @@ instance Show PatternMatchFail instance Show NoMethodError instance Show Deadlock-instance Show BlockedOnDeadMVar-instance Show BlockedIndefinitely+instance Show BlockedIndefinitelyOnMVar+instance Show BlockedIndefinitelyOnSTM instance Show ErrorCall instance Show RecConError instance Show RecSelError@@ -234,8 +234,8 @@ INSTANCE_TYPEABLE0(ErrorCall,errorCallTc,"ErrorCall") INSTANCE_TYPEABLE0(AssertionFailed,assertionFailedTc,"AssertionFailed") INSTANCE_TYPEABLE0(AsyncException,asyncExceptionTc,"AsyncException")-INSTANCE_TYPEABLE0(BlockedOnDeadMVar,blockedOnDeadMVarTc,"BlockedOnDeadMVar")-INSTANCE_TYPEABLE0(BlockedIndefinitely,blockedIndefinitelyTc,"BlockedIndefinitely")+INSTANCE_TYPEABLE0(BlockedIndefinitelyOnMVar,blockedIndefinitelyOnMVarTc,"BlockedIndefinitelyOnMVar")+INSTANCE_TYPEABLE0(BlockedIndefinitelyOnSTM,blockedIndefinitelyOnSTM,"BlockedIndefinitelyOnSTM") INSTANCE_TYPEABLE0(Deadlock,deadlockTc,"Deadlock") instance Exception SomeException where@@ -272,8 +272,8 @@ fromException (Hugs.Exception.ErrorCall s) = Just (ErrorCall s) fromException _ = Nothing -data BlockedOnDeadMVar = BlockedOnDeadMVar-data BlockedIndefinitely = BlockedIndefinitely+data BlockedIndefinitelyOnMVar = BlockedIndefinitelyOnMVar+data BlockedIndefinitelyOnSTM = BlockedIndefinitelyOnSTM data Deadlock = Deadlock data AssertionFailed = AssertionFailed String data AsyncException@@ -283,8 +283,8 @@ | UserInterrupt deriving (Eq, Ord) -instance Show BlockedOnDeadMVar where- showsPrec _ BlockedOnDeadMVar = showString "thread blocked indefinitely"+instance Show BlockedIndefinitelyOnMVar where+ showsPrec _ BlockedIndefinitelyOnMVar = showString "thread blocked indefinitely" instance Show BlockedIndefinitely where showsPrec _ BlockedIndefinitely = showString "thread blocked indefinitely"@@ -383,7 +383,7 @@ -> (e -> IO a) -- ^ Handler to invoke if an exception is raised -> IO a #if __GLASGOW_HASKELL__-catch = GHC.IOBase.catchException+catch = GHC.IO.catchException #elif __HUGS__ catch m h = Hugs.Exception.catchException m h' where h' e = case fromException e of@@ -474,7 +474,7 @@ -- | Like 'finally', but only performs the final action if there was an -- exception raised by the computation. onException :: IO a -> IO b -> IO a-onException io what = io `catch` \e -> do what+onException io what = io `catch` \e -> do _ <- what throw (e :: SomeException) -----------------------------------------------------------------------------@@ -509,7 +509,7 @@ block (do a <- before r <- unblock (thing a) `onException` after a- after a+ _ <- after a return r ) #endif@@ -524,7 +524,7 @@ a `finally` sequel = block (do r <- unblock a `onException` sequel- sequel+ _ <- sequel return r ) @@ -691,8 +691,6 @@ ----- -instance Exception Dynamic- #endif /* __GLASGOW_HASKELL__ || __HUGS__ */ #ifdef __GLASGOW_HASKELL__@@ -700,8 +698,9 @@ nonExhaustiveGuardsError, patError, noMethodBindingError :: Addr# -> a -- All take a UTF8-encoded C string -recSelError s = throw (RecSelError (unpackCStringUtf8# s)) -- No location info unfortunately-runtimeError s = error (unpackCStringUtf8# s) -- No location info unfortunately+recSelError s = throw (RecSelError ("No match in record selector "+ ++ unpackCStringUtf8# s)) -- No location info unfortunately+runtimeError s = error (unpackCStringUtf8# s) -- No location info unfortunately nonExhaustiveGuardsError s = throw (PatternMatchFail (untangle s "Non-exhaustive guards in")) irrefutPatError s = throw (PatternMatchFail (untangle s "Irrefutable pattern failed for pattern"))
Control/Monad/ST.hs view
@@ -32,8 +32,6 @@ unsafeSTToIO -- :: ST s a -> IO a ) where -import Prelude- import Control.Monad.Fix #include "Typeable.h"@@ -57,7 +55,7 @@ #ifdef __GLASGOW_HASKELL__ import GHC.ST ( ST, runST, fixST, unsafeInterleaveST ) import GHC.Base ( RealWorld )-import GHC.IOBase ( stToIO, unsafeIOToST, unsafeSTToIO )+import GHC.IO ( stToIO, unsafeIOToST, unsafeSTToIO ) #endif instance MonadFix (ST s) where
Control/Monad/ST/Lazy.hs view
@@ -36,13 +36,11 @@ import Control.Monad.Fix -import Control.Monad.ST (RealWorld) import qualified Control.Monad.ST as ST #ifdef __GLASGOW_HASKELL__ import qualified GHC.ST import GHC.Base-import Control.Monad #endif #ifdef __HUGS__
Control/Monad/ST/Strict.hs view
@@ -16,5 +16,4 @@ module Control.Monad.ST ) where -import Prelude import Control.Monad.ST
Control/OldException.hs view
@@ -29,7 +29,7 @@ -- ----------------------------------------------------------------------------- -module Control.OldException (+module Control.OldException {-# DEPRECATED "Future versions of base will not support the old exceptions style. Please switch to extensible exceptions." #-} ( -- * The Exception type Exception(..), -- instance Eq, Ord, Show, Typeable@@ -134,13 +134,15 @@ import GHC.Base import GHC.Num import GHC.Show-import GHC.IOBase ( IO )-import qualified GHC.IOBase as New+-- import GHC.IO ( IO )+import GHC.IO.Handle.FD ( stdout )+import qualified GHC.IO as New+import qualified GHC.IO.Exception as New import GHC.Conc hiding (setUncaughtExceptionHandler, getUncaughtExceptionHandler) import Data.IORef ( IORef, newIORef, readIORef, writeIORef ) import Foreign.C.String ( CString, withCString )-import GHC.Handle ( stdout, hFlush )+import GHC.IO.Handle ( hFlush ) #endif #ifdef __HUGS__@@ -454,8 +456,8 @@ a <- before r <- catch (unblock (thing a))- (\e -> do { after a; throw e })- after a+ (\e -> do { _ <- after a; throw e })+ _ <- after a return r ) #endif@@ -471,8 +473,8 @@ block (do r <- catch (unblock a)- (\e -> do { sequel; throw e })- sequel+ (\e -> do { _ <- sequel; throw e })+ _ <- sequel return r ) @@ -493,7 +495,7 @@ a <- before catch (unblock (thing a))- (\e -> do { after a; throw e })+ (\e -> do { _ <- after a; throw e }) ) -- -----------------------------------------------------------------------------@@ -714,8 +716,8 @@ Caster (\exc -> ArrayException exc), Caster (\(New.AssertionFailed err) -> AssertionFailed err), Caster (\exc -> AsyncException exc),- Caster (\New.BlockedOnDeadMVar -> BlockedOnDeadMVar),- Caster (\New.BlockedIndefinitely -> BlockedIndefinitely),+ Caster (\New.BlockedIndefinitelyOnMVar -> BlockedOnDeadMVar),+ Caster (\New.BlockedIndefinitelyOnSTM -> BlockedIndefinitely), Caster (\New.NestedAtomically -> NestedAtomically), Caster (\New.Deadlock -> Deadlock), Caster (\exc -> DynException exc),@@ -739,8 +741,8 @@ toException (ArrayException exc) = toException exc toException (AssertionFailed err) = toException (New.AssertionFailed err) toException (AsyncException exc) = toException exc- toException BlockedOnDeadMVar = toException New.BlockedOnDeadMVar- toException BlockedIndefinitely = toException New.BlockedIndefinitely+ toException BlockedOnDeadMVar = toException New.BlockedIndefinitelyOnMVar+ toException BlockedIndefinitely = toException New.BlockedIndefinitelyOnSTM toException NestedAtomically = toException New.NestedAtomically toException Deadlock = toException New.Deadlock -- If a dynamic exception is a SomeException then resurrect it, so@@ -774,8 +776,8 @@ showsPrec _ (AssertionFailed err) = showString err showsPrec _ (DynException err) = showString "exception :: " . showsTypeRep (dynTypeRep err) showsPrec _ (AsyncException e) = shows e- showsPrec p BlockedOnDeadMVar = showsPrec p New.BlockedOnDeadMVar- showsPrec p BlockedIndefinitely = showsPrec p New.BlockedIndefinitely+ showsPrec p BlockedOnDeadMVar = showsPrec p New.BlockedIndefinitelyOnMVar+ showsPrec p BlockedIndefinitely = showsPrec p New.BlockedIndefinitelyOnSTM showsPrec p NestedAtomically = showsPrec p New.NestedAtomically showsPrec p NonTermination = showsPrec p New.NonTermination showsPrec p Deadlock = showsPrec p New.Deadlock
Data/Bits.hs view
@@ -48,7 +48,6 @@ #ifdef __GLASGOW_HASKELL__ import GHC.Num-import GHC.Real import GHC.Base #endif @@ -218,9 +217,9 @@ I# (word2Int# ((x'# `uncheckedShiftL#` i'#) `or#` (x'# `uncheckedShiftRL#` (wsib -# i'#)))) where- x'# = int2Word# x#- i'# = word2Int# (int2Word# i# `and#` int2Word# (wsib -# 1#))- wsib = WORD_SIZE_IN_BITS# {- work around preprocessor problem (??) -}+ !x'# = int2Word# x#+ !i'# = word2Int# (int2Word# i# `and#` int2Word# (wsib -# 1#))+ !wsib = WORD_SIZE_IN_BITS# {- work around preprocessor problem (??) -} bitSize _ = WORD_SIZE_IN_BITS {-# INLINE shiftR #-}@@ -292,8 +291,8 @@ complement a = -1 - a #endif - shift x i | i >= 0 = x * 2^i- | otherwise = x `div` 2^(-i)+ shift x i@(I# i#) | i >= 0 = shiftLInteger x i#+ | otherwise = shiftRInteger x (negateInt# i#) rotate x i = shift x i -- since an Integer never wraps around
Data/Data.hs view
@@ -54,6 +54,8 @@ mkIntType, -- :: String -> DataType mkFloatType, -- :: String -> DataType mkStringType, -- :: String -> DataType+ mkCharType, -- :: String -> DataType+ mkNoRepType, -- :: String -> DataType mkNorepType, -- :: String -> DataType -- ** Observers dataTypeName, -- :: DataType -> String@@ -74,8 +76,11 @@ -- ** Constructors mkConstr, -- :: DataType -> String -> Fixity -> Constr mkIntConstr, -- :: DataType -> Integer -> Constr- mkFloatConstr, -- :: DataType -> Double -> Constr+ mkFloatConstr, -- :: DataType -> Double -> Constr+ mkIntegralConstr,-- :: (Integral a) => DataType -> a -> Constr+ mkRealConstr, -- :: (Real a) => DataType -> a -> Constr mkStringConstr, -- :: DataType -> String -> Constr+ mkCharConstr, -- :: DataType -> Char -> Constr -- ** Observers constrType, -- :: Constr -> DataType ConstrRep(..), -- instance of: Eq, Show@@ -109,7 +114,6 @@ import Control.Monad -- Imports for the instances-import Data.Typeable import Data.Int -- So we can give Data instance for Int8, ... import Data.Word -- So we can give Data instance for Word8, ... #ifdef __GLASGOW_HASKELL__@@ -125,14 +129,9 @@ # ifdef __HUGS__ import Hugs.Prelude( Ratio(..) ) # endif-import System.IO import Foreign.Ptr import Foreign.ForeignPtr-import Foreign.StablePtr-import Control.Monad.ST-import Control.Concurrent import Data.Array-import Data.IORef #endif #include "Typeable.h"@@ -437,7 +436,7 @@ -- | Build a term skeleton fromConstr :: Data a => Constr -> a-fromConstr = fromConstrB undefined+fromConstr = fromConstrB (error "Data.Data.fromConstr") -- | Build a term and use a generic function for subterms@@ -504,7 +503,7 @@ data DataRep = AlgRep [Constr] | IntRep | FloatRep- | StringRep+ | CharRep | NoRep deriving (Eq,Show)@@ -514,8 +513,8 @@ -- | Public representation of constructors data ConstrRep = AlgConstr ConIndex | IntConstr Integer- | FloatConstr Double- | StringConstr String+ | FloatConstr Rational+ | CharConstr Char deriving (Eq,Show) @@ -566,8 +565,8 @@ case (dataTypeRep dt, cr) of (AlgRep cs, AlgConstr i) -> cs !! (i-1) (IntRep, IntConstr i) -> mkIntConstr dt i- (FloatRep, FloatConstr f) -> mkFloatConstr dt f- (StringRep, StringConstr str) -> mkStringConstr dt str+ (FloatRep, FloatConstr f) -> mkRealConstr dt f+ (CharRep, CharConstr c) -> mkCharConstr dt c _ -> error "repConstr" @@ -640,8 +639,8 @@ case dataTypeRep dt of AlgRep cons -> idx cons IntRep -> mkReadCon (\i -> (mkPrimCon dt str (IntConstr i)))- FloatRep -> mkReadCon (\f -> (mkPrimCon dt str (FloatConstr f)))- StringRep -> Just (mkStringConstr dt str)+ FloatRep -> mkReadCon ffloat+ CharRep -> mkReadCon (\c -> (mkPrimCon dt str (CharConstr c))) NoRep -> Nothing where @@ -658,6 +657,8 @@ then Nothing else Just (head fit) + ffloat :: Double -> Constr+ ffloat = mkPrimCon dt str . FloatConstr . toRational ------------------------------------------------------------------------------ --@@ -712,11 +713,16 @@ mkFloatType = mkPrimType FloatRep --- | Constructs the 'String' type+-- | This function is now deprecated. Please use 'mkCharType' instead.+{-# DEPRECATED mkStringType "Use mkCharType instead" #-} mkStringType :: String -> DataType-mkStringType = mkPrimType StringRep+mkStringType = mkCharType +-- | Constructs the 'Char' type+mkCharType :: String -> DataType+mkCharType = mkPrimType CharRep + -- | Helper for 'mkIntType', 'mkFloatType', 'mkStringType' mkPrimType :: DataRep -> String -> DataType mkPrimType dr str = DataType@@ -735,25 +741,43 @@ , confixity = error "constrFixity" } -+-- | This function is now deprecated. Please use 'mkIntegralConstr' instead.+{-# DEPRECATED mkIntConstr "Use mkIntegralConstr instead" #-} mkIntConstr :: DataType -> Integer -> Constr-mkIntConstr dt i = case datarep dt of- IntRep -> mkPrimCon dt (show i) (IntConstr i)- _ -> error "mkIntConstr"+mkIntConstr = mkIntegralConstr +mkIntegralConstr :: (Integral a) => DataType -> a -> Constr+mkIntegralConstr dt i = case datarep dt of+ IntRep -> mkPrimCon dt (show i) (IntConstr (toInteger i))+ _ -> error "mkIntegralConstr" +-- | This function is now deprecated. Please use 'mkRealConstr' instead.+{-# DEPRECATED mkFloatConstr "Use mkRealConstr instead" #-} mkFloatConstr :: DataType -> Double -> Constr-mkFloatConstr dt f = case datarep dt of- FloatRep -> mkPrimCon dt (show f) (FloatConstr f)- _ -> error "mkFloatConstr"+mkFloatConstr dt = mkRealConstr dt . toRational +mkRealConstr :: (Real a) => DataType -> a -> Constr+mkRealConstr dt f = case datarep dt of+ FloatRep -> mkPrimCon dt (show f) (FloatConstr (toRational f))+ _ -> error "mkRealConstr" +-- | This function is now deprecated. Please use 'mkCharConstr' instead.+{-# DEPRECATED mkStringConstr "Use mkCharConstr instead" #-} mkStringConstr :: DataType -> String -> Constr-mkStringConstr dt str = case datarep dt of- StringRep -> mkPrimCon dt str (StringConstr str)- _ -> error "mkStringConstr"+mkStringConstr dt str =+ case datarep dt of+ CharRep -> case str of+ [c] -> mkPrimCon dt (show c) (CharConstr c)+ _ -> error "mkStringConstr: input String must contain a single character"+ _ -> error "mkStringConstr" +-- | Makes a constructor for 'Char'.+mkCharConstr :: DataType -> Char -> Constr+mkCharConstr dt c = case datarep dt of+ CharRep -> mkPrimCon dt (show c) (CharConstr c)+ _ -> error "mkCharConstr" + ------------------------------------------------------------------------------ -- -- Non-representations for non-presentable types@@ -761,13 +785,20 @@ ------------------------------------------------------------------------------ --- | Constructs a non-representation for a non-presentable type+-- | Deprecated version (misnamed)+{-# DEPRECATED mkNorepType "Use mkNoRepType instead" #-} mkNorepType :: String -> DataType mkNorepType str = DataType { tycon = str , datarep = NoRep } +-- | Constructs a non-representation for a non-presentable type+mkNoRepType :: String -> DataType+mkNoRepType str = DataType+ { tycon = str+ , datarep = NoRep+ } -- | Test for a non-representable type isNorepType :: DataType -> Bool@@ -836,12 +867,12 @@ ------------------------------------------------------------------------------ charType :: DataType-charType = mkStringType "Prelude.Char"+charType = mkCharType "Prelude.Char" instance Data Char where- toConstr x = mkStringConstr charType [x]+ toConstr x = mkCharConstr charType x gunfold _ z c = case constrRep c of- (StringConstr [x]) -> z x+ (CharConstr x) -> z x _ -> error "gunfold" dataTypeOf _ = charType @@ -852,7 +883,7 @@ floatType = mkFloatType "Prelude.Float" instance Data Float where- toConstr x = mkFloatConstr floatType (realToFrac x)+ toConstr = mkRealConstr floatType gunfold _ z c = case constrRep c of (FloatConstr x) -> z (realToFrac x) _ -> error "gunfold"@@ -865,9 +896,9 @@ doubleType = mkFloatType "Prelude.Double" instance Data Double where- toConstr = mkFloatConstr floatType+ toConstr = mkRealConstr doubleType gunfold _ z c = case constrRep c of- (FloatConstr x) -> z x+ (FloatConstr x) -> z (realToFrac x) _ -> error "gunfold" dataTypeOf _ = doubleType @@ -1265,7 +1296,7 @@ instance Typeable a => Data (Ptr a) where toConstr _ = error "toConstr" gunfold _ _ = error "gunfold"- dataTypeOf _ = mkNorepType "GHC.Ptr.Ptr"+ dataTypeOf _ = mkNoRepType "GHC.Ptr.Ptr" ------------------------------------------------------------------------------@@ -1273,7 +1304,7 @@ instance Typeable a => Data (ForeignPtr a) where toConstr _ = error "toConstr" gunfold _ _ = error "gunfold"- dataTypeOf _ = mkNorepType "GHC.ForeignPtr.ForeignPtr"+ dataTypeOf _ = mkNoRepType "GHC.ForeignPtr.ForeignPtr" ------------------------------------------------------------------------------@@ -1284,5 +1315,5 @@ gfoldl f z a = z (listArray (bounds a)) `f` (elems a) toConstr _ = error "toConstr" gunfold _ _ = error "gunfold"- dataTypeOf _ = mkNorepType "Data.Array.Array"+ dataTypeOf _ = mkNoRepType "Data.Array.Array"
Data/Dynamic.hs view
@@ -47,8 +47,8 @@ #ifdef __GLASGOW_HASKELL__ import GHC.Base import GHC.Show-import GHC.Err import GHC.Num+import GHC.Exception #endif #ifdef __HUGS__@@ -92,6 +92,11 @@ showString "<<" . showsPrec 0 t . showString ">>"++#ifdef __GLASGOW_HASKELL__+-- here so that it isn't an orphan:+instance Exception Dynamic+#endif #ifdef __GLASGOW_HASKELL__ type Obj = Any
Data/Fixed.hs view
@@ -3,7 +3,7 @@ ----------------------------------------------------------------------------- -- | -- Module : Data.Fixed--- Copyright : (c) Ashley Yakeley 2005, 2006+-- Copyright : (c) Ashley Yakeley 2005, 2006, 2009 -- License : BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer : Ashley Yakeley <ashley@semantic.org>@@ -13,8 +13,6 @@ -- This module defines a \"Fixed\" type for fixed-precision arithmetic. -- The parameter to Fixed is any type that's an instance of HasResolution. -- HasResolution has a single method that gives the resolution of the Fixed type.--- Parameter types E6 and E12 (for 10^6 and 10^12) are defined, as well as--- type synonyms for Fixed E6 and Fixed E12. -- -- This module also contains generalisations of div, mod, and divmod to work -- with any Real instance.@@ -23,16 +21,25 @@ module Data.Fixed (- div',mod',divMod',+ div',mod',divMod', - Fixed,HasResolution(..),- showFixed,- E6,Micro,- E12,Pico+ Fixed,HasResolution(..),+ showFixed,+ E0,Uni,+ E1,Deci,+ E2,Centi,+ E3,Milli,+ E6,Micro,+ E9,Nano,+ E12,Pico ) where import Prelude -- necessary to get dependencies right+import Data.Typeable+import Data.Data +default () -- avoid any defaulting shenanigans+ -- | generalisation of 'div' to any instance of Real div' :: (Real a,Integral b) => a -> a -> b div' n d = floor ((toRational n) / (toRational d))@@ -40,64 +47,72 @@ -- | generalisation of 'divMod' to any instance of Real divMod' :: (Real a,Integral b) => a -> a -> (b,a) divMod' n d = (f,n - (fromIntegral f) * d) where- f = div' n d+ f = div' n d -- | generalisation of 'mod' to any instance of Real mod' :: (Real a) => a -> a -> a mod' n d = n - (fromInteger f) * d where- f = div' n d+ f = div' n d -newtype Fixed a = MkFixed Integer deriving (Eq,Ord)+-- | The type parameter should be an instance of 'HasResolution'.+newtype Fixed a = MkFixed Integer deriving (Eq,Ord,Typeable) -class HasResolution a where- resolution :: a -> Integer+-- We do this because the automatically derived Data instance requires (Data a) context.+-- Our manual instance has the more general (Typeable a) context.+tyFixed :: DataType+tyFixed = mkDataType "Data.Fixed.Fixed" [conMkFixed]+conMkFixed :: Constr+conMkFixed = mkConstr tyFixed "MkFixed" [] Prefix+instance (Typeable a) => Data (Fixed a) where+ gfoldl k z (MkFixed a) = k (z MkFixed) a+ gunfold k z _ = k (z MkFixed)+ dataTypeOf _ = tyFixed+ toConstr _ = conMkFixed -fixedResolution :: (HasResolution a) => Fixed a -> Integer-fixedResolution fa = resolution (uf fa) where- uf :: Fixed a -> a- uf _ = undefined+class HasResolution a where+ resolution :: p a -> Integer -withType :: (a -> f a) -> f a+withType :: (p a -> f a) -> f a withType foo = foo undefined withResolution :: (HasResolution a) => (Integer -> f a) -> f a withResolution foo = withType (foo . resolution) instance Enum (Fixed a) where- succ (MkFixed a) = MkFixed (succ a)- pred (MkFixed a) = MkFixed (pred a)- toEnum = MkFixed . toEnum- fromEnum (MkFixed a) = fromEnum a- enumFrom (MkFixed a) = fmap MkFixed (enumFrom a)- enumFromThen (MkFixed a) (MkFixed b) = fmap MkFixed (enumFromThen a b)- enumFromTo (MkFixed a) (MkFixed b) = fmap MkFixed (enumFromTo a b)- enumFromThenTo (MkFixed a) (MkFixed b) (MkFixed c) = fmap MkFixed (enumFromThenTo a b c)+ succ (MkFixed a) = MkFixed (succ a)+ pred (MkFixed a) = MkFixed (pred a)+ toEnum = MkFixed . toEnum+ fromEnum (MkFixed a) = fromEnum a+ enumFrom (MkFixed a) = fmap MkFixed (enumFrom a)+ enumFromThen (MkFixed a) (MkFixed b) = fmap MkFixed (enumFromThen a b)+ enumFromTo (MkFixed a) (MkFixed b) = fmap MkFixed (enumFromTo a b)+ enumFromThenTo (MkFixed a) (MkFixed b) (MkFixed c) = fmap MkFixed (enumFromThenTo a b c) instance (HasResolution a) => Num (Fixed a) where- (MkFixed a) + (MkFixed b) = MkFixed (a + b)- (MkFixed a) - (MkFixed b) = MkFixed (a - b)- fa@(MkFixed a) * (MkFixed b) = MkFixed (div (a * b) (fixedResolution fa))- negate (MkFixed a) = MkFixed (negate a)- abs (MkFixed a) = MkFixed (abs a)- signum (MkFixed a) = fromInteger (signum a)- fromInteger i = withResolution (\res -> MkFixed (i * res))+ (MkFixed a) + (MkFixed b) = MkFixed (a + b)+ (MkFixed a) - (MkFixed b) = MkFixed (a - b)+ fa@(MkFixed a) * (MkFixed b) = MkFixed (div (a * b) (resolution fa))+ negate (MkFixed a) = MkFixed (negate a)+ abs (MkFixed a) = MkFixed (abs a)+ signum (MkFixed a) = fromInteger (signum a)+ fromInteger i = withResolution (\res -> MkFixed (i * res)) instance (HasResolution a) => Real (Fixed a) where- toRational fa@(MkFixed a) = (toRational a) / (toRational (fixedResolution fa))+ toRational fa@(MkFixed a) = (toRational a) / (toRational (resolution fa)) instance (HasResolution a) => Fractional (Fixed a) where- fa@(MkFixed a) / (MkFixed b) = MkFixed (div (a * (fixedResolution fa)) b)- recip fa@(MkFixed a) = MkFixed (div (res * res) a) where- res = fixedResolution fa- fromRational r = withResolution (\res -> MkFixed (floor (r * (toRational res))))+ fa@(MkFixed a) / (MkFixed b) = MkFixed (div (a * (resolution fa)) b)+ recip fa@(MkFixed a) = MkFixed (div (res * res) a) where+ res = resolution fa+ fromRational r = withResolution (\res -> MkFixed (floor (r * (toRational res)))) instance (HasResolution a) => RealFrac (Fixed a) where- properFraction a = (i,a - (fromIntegral i)) where- i = truncate a- truncate f = truncate (toRational f)- round f = round (toRational f)- ceiling f = ceiling (toRational f)- floor f = floor (toRational f)+ properFraction a = (i,a - (fromIntegral i)) where+ i = truncate a+ truncate f = truncate (toRational f)+ round f = round (toRational f)+ ceiling f = ceiling (toRational f)+ floor f = floor (toRational f) chopZeros :: Integer -> String chopZeros 0 = ""@@ -108,8 +123,8 @@ showIntegerZeros :: Bool -> Int -> Integer -> String showIntegerZeros True _ 0 = "" showIntegerZeros chopTrailingZeros digits a = replicate (digits - length s) '0' ++ s' where- s = show a- s' = if chopTrailingZeros then chopZeros a else s+ s = show a+ s' = if chopTrailingZeros then chopZeros a else s withDot :: String -> String withDot "" = ""@@ -119,29 +134,55 @@ showFixed :: (HasResolution a) => Bool -> Fixed a -> String showFixed chopTrailingZeros fa@(MkFixed a) | a < 0 = "-" ++ (showFixed chopTrailingZeros (asTypeOf (MkFixed (negate a)) fa)) showFixed chopTrailingZeros fa@(MkFixed a) = (show i) ++ (withDot (showIntegerZeros chopTrailingZeros digits fracNum)) where- res = fixedResolution fa- (i,d) = divMod a res- -- enough digits to be unambiguous- digits = ceiling (logBase 10 (fromInteger res) :: Double)- maxnum = 10 ^ digits- fracNum = div (d * maxnum) res+ res = resolution fa+ (i,d) = divMod a res+ -- enough digits to be unambiguous+ digits = ceiling (logBase 10 (fromInteger res) :: Double)+ maxnum = 10 ^ digits+ fracNum = div (d * maxnum) res instance (HasResolution a) => Show (Fixed a) where- show = showFixed False+ show = showFixed False +data E0 = E0 deriving (Typeable)+instance HasResolution E0 where+ resolution _ = 1+-- | resolution of 1, this works the same as Integer+type Uni = Fixed E0 -data E6 = E6+data E1 = E1 deriving (Typeable)+instance HasResolution E1 where+ resolution _ = 10+-- | resolution of 10^-1 = .1+type Deci = Fixed E1 -instance HasResolution E6 where- resolution _ = 1000000+data E2 = E2 deriving (Typeable)+instance HasResolution E2 where+ resolution _ = 100+-- | resolution of 10^-2 = .01, useful for many monetary currencies+type Centi = Fixed E2 -type Micro = Fixed E6+data E3 = E3 deriving (Typeable)+instance HasResolution E3 where+ resolution _ = 1000+-- | resolution of 10^-3 = .001+type Milli = Fixed E3 +data E6 = E6 deriving (Typeable)+instance HasResolution E6 where+ resolution _ = 1000000+-- | resolution of 10^-6 = .000001+type Micro = Fixed E6 -data E12 = E12+data E9 = E9 deriving (Typeable)+instance HasResolution E9 where+ resolution _ = 1000000000+-- | resolution of 10^-9 = .000000001+type Nano = Fixed E9 +data E12 = E12 deriving (Typeable) instance HasResolution E12 where- resolution _ = 1000000000000-+ resolution _ = 1000000000000+-- | resolution of 10^-12 = .000000000001 type Pico = Fixed E12
Data/Foldable.hs view
@@ -226,6 +226,7 @@ -- | List of elements of a structure. toList :: Foldable t => t a -> [a]+{-# INLINE toList #-} #ifdef __GLASGOW_HASKELL__ toList t = build (\ c n -> foldr c n t) #else
+ Data/Functor.hs view
@@ -0,0 +1,28 @@+-----------------------------------------------------------------------------+-- |+-- Module : Data.Functor+-- Copyright : (c) The University of Glasgow 2001+-- License : BSD-style (see the file libraries/base/LICENSE)+-- +-- Maintainer : libraries@haskell.org+-- Stability : provisional+-- Portability : portable+--+-- Functors: uniform action over a parameterized type, generalizing the+-- 'map' function on lists.++module Data.Functor+ (+ Functor(fmap, (<$)),+ (<$>),+ ) where++#ifdef __GLASGOW_HASKELL__+import GHC.Base (Functor(..))+#endif++infixl 4 <$>++-- | An infix synonym for 'fmap'.+(<$>) :: Functor f => (a -> b) -> f a -> f b+(<$>) = fmap
Data/HashTable.hs view
@@ -50,9 +50,9 @@ import GHC.Show ( Show(..) ) import GHC.Int ( Int64 ) -import GHC.IOBase ( IO, IOArray, newIOArray,- unsafeReadIOArray, unsafeWriteIOArray, unsafePerformIO,- IORef, newIORef, readIORef, writeIORef )+import GHC.IO+import GHC.IOArray+import GHC.IORef #else import Data.Char ( ord ) import Data.IORef ( IORef, newIORef, readIORef, writeIORef )@@ -77,27 +77,16 @@ readHTArray :: HTArray a -> Int32 -> IO a writeMutArray :: MutArray a -> Int32 -> a -> IO ()-freezeArray :: MutArray a -> IO (HTArray a)-thawArray :: HTArray a -> IO (MutArray a) newMutArray :: (Int32, Int32) -> a -> IO (MutArray a)-#if defined(DEBUG) || defined(__NHC__)+newMutArray = newIOArray type MutArray a = IOArray Int32 a type HTArray a = MutArray a-newMutArray = newIOArray+#if defined(DEBUG) || defined(__NHC__) readHTArray = readIOArray writeMutArray = writeIOArray-freezeArray = return-thawArray = return #else-type MutArray a = IOArray Int32 a-type HTArray a = MutArray a -- Array Int32 a-newMutArray = newIOArray-readHTArray arr i = readMutArray arr i -- return $! (unsafeAt arr (fromIntegral i))-readMutArray :: MutArray a -> Int32 -> IO a-readMutArray arr i = unsafeReadIOArray arr (fromIntegral i)+readHTArray arr i = unsafeReadIOArray arr (fromIntegral i) writeMutArray arr i x = unsafeWriteIOArray arr (fromIntegral i) x-freezeArray = return -- unsafeFreeze-thawArray = return -- unsafeThaw #endif data HashTable key val = HashTable {@@ -285,8 +274,7 @@ recordNew -- make a new hash table with a single, empty, segment let mask = tABLE_MIN-1- bkts' <- newMutArray (0,mask) []- bkts <- freezeArray bkts'+ bkts <- newMutArray (0,mask) [] let kcnt = 0@@ -369,9 +357,7 @@ (bckt', inserts, result) <- return $ bucketFn bckt let k' = k + inserts table1 = table { kcount=k' }- bkts' <- thawArray bkts- writeMutArray bkts' indx bckt'- freezeArray bkts'+ writeMutArray bkts indx bckt' table2 <- if canEnlarge == CanInsert && inserts > 0 then do recordIns inserts k' bckt' if tooBig k' b@@ -392,18 +378,16 @@ then return table else do --- newbkts' <- newMutArray (0,newmask) []+ newbkts <- newMutArray (0,newmask) [] let splitBucket oldindex = do bucket <- readHTArray bkts oldindex let (oldb,newb) = partition ((oldindex==). bucketIndex newmask . hash . fst) bucket- writeMutArray newbkts' oldindex oldb- writeMutArray newbkts' (oldindex + oldsize) newb+ writeMutArray newbkts oldindex oldb+ writeMutArray newbkts (oldindex + oldsize) newb mapM_ splitBucket [0..mask]-- newbkts <- freezeArray newbkts' return ( table{ buckets=newbkts, bmask=newmask } )
Data/IORef.hs view
@@ -35,7 +35,9 @@ #ifdef __GLASGOW_HASKELL__ import GHC.Base import GHC.STRef-import GHC.IOBase+-- import GHC.IO+import GHC.IORef hiding (atomicModifyIORef)+import qualified GHC.IORef #if !defined(__PARALLEL_HASKELL__) import GHC.Weak #endif@@ -75,7 +77,7 @@ -- atomicModifyIORef :: IORef a -> (a -> (a,b)) -> IO b #if defined(__GLASGOW_HASKELL__)-atomicModifyIORef (IORef (STRef r#)) f = IO $ \s -> atomicModifyMutVar# r# f s+atomicModifyIORef = GHC.IORef.atomicModifyIORef #elif defined(__HUGS__) atomicModifyIORef = plainModifyIORef -- Hugs has no preemption
Data/Ix.hs view
@@ -60,7 +60,7 @@ ) where -import Prelude+-- import Prelude #ifdef __GLASGOW_HASKELL__ import GHC.Arr
Data/List.hs view
@@ -399,6 +399,9 @@ -- > [1,2,3,4] `intersect` [2,4,6,8] == [2,4] -- -- If the first list contains duplicates, so will the result.+--+-- > [1,2,2,3,4] `intersect` [6,4,4,2] == [2,2,4]+-- -- It is a special case of 'intersectBy', which allows the programmer to -- supply their own equality test. @@ -567,6 +570,17 @@ genericLength :: (Num i) => [b] -> i genericLength [] = 0 genericLength (_:l) = 1 + genericLength l++{-# RULES+ "genericLengthInt" genericLength = (strictGenericLength :: [a] -> Int);+ "genericLengthInteger" genericLength = (strictGenericLength :: [a] -> Integer);+ #-}++strictGenericLength :: (Num i) => [b] -> i+strictGenericLength l = gl l 0+ where+ gl [] a = a+ gl (_:xs) a = let a' = a + 1 in a' `seq` gl xs a' -- | The 'genericTake' function is an overloaded version of 'take', which -- accepts any 'Integral' value as the number of elements to take.
Data/Monoid.hs view
@@ -9,13 +9,8 @@ -- Stability : experimental -- Portability : portable ----- The Monoid class with various general-purpose instances.------ Inspired by the paper--- /Functional Programming with Overloading and--- Higher-Order Polymorphism/,--- Mark P Jones (<http://citeseer.ist.psu.edu/jones95functional.html>)--- Advanced School of Functional Programming, 1995.+-- A class for monoids (types with an associative binary operation that+-- has an identity) with various general-purpose instances. ----------------------------------------------------------------------------- module Data.Monoid (@@ -44,9 +39,26 @@ -- -} -- ------------------------------------------------------------------------------ | The monoid class.--- A minimal complete definition must supply 'mempty' and 'mappend',--- and these should satisfy the monoid laws.+-- | The class of monoids (types with an associative binary operation that+-- has an identity). Instances should satisfy the following laws:+--+-- * @mappend mempty x = x@+--+-- * @mappend x mempty = x@+--+-- * @mappend x (mappend y z) = mappend (mappend x y) z@+--+-- * @mconcat = 'foldr' mappend mempty@+--+-- The method names refer to the monoid of lists under concatenation,+-- but there are many other instances.+--+-- Minimal complete definition: 'mempty' and 'mappend'.+--+-- Some types can be viewed as a monoid in more than one way,+-- e.g. both addition and multiplication on numbers.+-- In such cases we often define @newtype@s and make those instances+-- of 'Monoid', e.g. 'Sum' and 'Product'. class Monoid a where mempty :: a
Data/STRef/Lazy.hs view
@@ -22,6 +22,7 @@ import Control.Monad.ST.Lazy import qualified Data.STRef as ST+import Prelude newSTRef :: a -> ST s (ST.STRef s a) readSTRef :: ST.STRef s a -> ST s a
Data/STRef/Strict.hs view
@@ -16,5 +16,4 @@ module Data.STRef ) where -import Prelude import Data.STRef
Data/Tuple.hs view
@@ -75,6 +75,10 @@ ) #endif +#ifdef __GLASGOW_HASKELL__+import GHC.Unit ()+#endif+ default () -- Double isn't available yet #ifdef __GLASGOW_HASKELL__
Data/Typeable.hs view
@@ -21,7 +21,7 @@ -- and one can in turn define a type-safe cast operation. To this end, -- an unsafe cast is guarded by a test for type (representation) -- equivalence. The module "Data.Dynamic" uses Typeable for an--- implementation of dynamics. The module "Data.Generics" uses Typeable+-- implementation of dynamics. The module "Data.Data" uses Typeable -- and type-safe cast (but not dynamics) to support the \"Scrap your -- boilerplate\" style of generic programming. --@@ -95,12 +95,14 @@ import GHC.Err (undefined) import GHC.Num (Integer, fromInteger, (+)) import GHC.Real ( rem, Ratio )-import GHC.IOBase (IORef,newIORef,unsafePerformIO)+import GHC.IORef (IORef,newIORef)+import GHC.IO (unsafePerformIO,block) -- These imports are so we can define Typeable instances -- It'd be better to give Typeable instances in the modules themselves -- but they all have to be compiled before Typeable-import GHC.IOBase ( IOArray, IO, MVar, Handle, block )+import GHC.IOArray+import GHC.MVar import GHC.ST ( ST ) import GHC.STRef ( STRef ) import GHC.Ptr ( Ptr, FunPtr )@@ -488,7 +490,7 @@ INSTANCE_TYPEABLE1(IO,ioTc,"IO") #if defined(__GLASGOW_HASKELL__) || defined(__HUGS__)--- Types defined in GHC.IOBase+-- Types defined in GHC.MVar INSTANCE_TYPEABLE1(MVar,mvarTc,"MVar" ) #endif @@ -538,7 +540,9 @@ #endif INSTANCE_TYPEABLE0(Integer,integerTc,"Integer") INSTANCE_TYPEABLE0(Ordering,orderingTc,"Ordering")+#ifndef __GLASGOW_HASKELL__ INSTANCE_TYPEABLE0(Handle,handleTc,"Handle")+#endif INSTANCE_TYPEABLE0(Int8,int8Tc,"Int8") INSTANCE_TYPEABLE0(Int16,int16Tc,"Int16")
Data/Typeable.hs-boot view
@@ -5,14 +5,12 @@ import Data.Maybe import GHC.Base-import GHC.Show data TypeRep data TyCon mkTyCon :: String -> TyCon mkTyConApp :: TyCon -> [TypeRep] -> TypeRep-showsTypeRep :: TypeRep -> ShowS cast :: (Typeable a, Typeable b) => a -> Maybe b
Foreign/C/Error.hs view
@@ -108,7 +108,9 @@ import Data.Maybe #if __GLASGOW_HASKELL__-import GHC.IOBase+import GHC.IO+import GHC.IO.Exception+import GHC.IO.Handle.Types import GHC.Num import GHC.Base #elif __HUGS__@@ -356,8 +358,9 @@ else throwErrno loc else return res --- | as 'throwErrnoIfRetry', but checks for operations that would block and--- executes an alternative action before retrying in that case.+-- | as 'throwErrnoIfRetry', but additionlly if the operation +-- yields the error code 'eAGAIN' or 'eWOULDBLOCK', an alternative+-- action is executed before retrying. -- throwErrnoIfRetryMayBlock :: (a -> Bool) -- ^ predicate to apply to the result value@@ -376,7 +379,8 @@ if err == eINTR then throwErrnoIfRetryMayBlock pred loc f on_block else if err == eWOULDBLOCK || err == eAGAIN- then do on_block; throwErrnoIfRetryMayBlock pred loc f on_block+ then do _ <- on_block+ throwErrnoIfRetryMayBlock pred loc f on_block else throwErrno loc else return res @@ -498,8 +502,9 @@ errnoToIOError loc errno maybeHdl maybeName = unsafePerformIO $ do str <- strerror errno >>= peekCString #if __GLASGOW_HASKELL__- return (IOError maybeHdl errType loc str maybeName)+ return (IOError maybeHdl errType loc str (Just errno') maybeName) where+ Errno errno' = errno errType | errno == eOK = OtherError | errno == e2BIG = ResourceExhausted
Foreign/C/String.hs view
@@ -99,7 +99,6 @@ import GHC.List import GHC.Real import GHC.Num-import GHC.IOBase import GHC.Base #else import Data.Char ( chr, ord )
Foreign/C/Types.hs view
@@ -50,7 +50,11 @@ -- 'Prelude.Show', 'Prelude.Enum', 'Typeable', 'Storable', -- 'Prelude.Real', 'Prelude.Fractional', 'Prelude.Floating', -- 'Prelude.RealFrac' and 'Prelude.RealFloat'.- , CFloat, CDouble, CLDouble+ , CFloat, CDouble+-- GHC doesn't support CLDouble yet+#ifndef __GLASGOW_HASKELL__+ , CLDouble+#endif #else -- Exported non-abstractly in nhc98 to fix an interface file problem. CChar(..), CSChar(..), CUChar(..)@@ -69,11 +73,11 @@ #ifndef __NHC__ -import {-# SOURCE #-} Foreign.Storable+import Foreign.Storable import Data.Bits ( Bits(..) ) import Data.Int ( Int8, Int16, Int32, Int64 ) import Data.Word ( Word8, Word16, Word32, Word64 )-import {-# SOURCE #-} Data.Typeable+import {-# SOURCE #-} Data.Typeable (Typeable(typeOf), TyCon, mkTyCon, mkTyConApp) #ifdef __GLASGOW_HASKELL__ import GHC.Base@@ -151,19 +155,24 @@ FLOATING_TYPE(CFloat,tyConCFloat,"CFloat",HTYPE_FLOAT) -- | Haskell type representing the C @double@ type. FLOATING_TYPE(CDouble,tyConCDouble,"CDouble",HTYPE_DOUBLE)+-- GHC doesn't support CLDouble yet+#ifndef __GLASGOW_HASKELL__ -- HACK: Currently no long double in the FFI, so we simply re-use double -- | Haskell type representing the C @long double@ type. FLOATING_TYPE(CLDouble,tyConCLDouble,"CLDouble",HTYPE_DOUBLE)+#endif {-# RULES "realToFrac/a->CFloat" realToFrac = \x -> CFloat (realToFrac x) "realToFrac/a->CDouble" realToFrac = \x -> CDouble (realToFrac x)-"realToFrac/a->CLDouble" realToFrac = \x -> CLDouble (realToFrac x) "realToFrac/CFloat->a" realToFrac = \(CFloat x) -> realToFrac x "realToFrac/CDouble->a" realToFrac = \(CDouble x) -> realToFrac x-"realToFrac/CLDouble->a" realToFrac = \(CLDouble x) -> realToFrac x #-}++-- GHC doesn't support CLDouble yet+-- "realToFrac/a->CLDouble" realToFrac = \x -> CLDouble (realToFrac x)+-- "realToFrac/CLDouble->a" realToFrac = \(CLDouble x) -> realToFrac x -- | Haskell type representing the C @ptrdiff_t@ type. INTEGRAL_TYPE(CPtrdiff,tyConCPtrdiff,"CPtrdiff",HTYPE_PTRDIFF_T)
Foreign/Concurrent.hs view
@@ -28,7 +28,7 @@ ) where #ifdef __GLASGOW_HASKELL__-import GHC.IOBase ( IO )+import GHC.IO ( IO ) import GHC.Ptr ( Ptr ) import GHC.ForeignPtr ( ForeignPtr ) import qualified GHC.ForeignPtr@@ -39,10 +39,9 @@ -- ^Turns a plain memory reference into a foreign object by associating -- a finalizer - given by the monadic operation - with the reference. -- The finalizer will be executed after the last reference to the--- foreign object is dropped. Note that there is no guarantee on how--- soon the finalizer is executed after the last reference was dropped;--- this depends on the details of the Haskell storage manager. The only--- guarantee is that the finalizer runs before the program terminates.+-- foreign object is dropped. There is no guarantee of promptness, and+-- in fact there is no guarantee that the finalizer will eventually+-- run at all. newForeignPtr = GHC.ForeignPtr.newConcForeignPtr addForeignPtrFinalizer :: ForeignPtr a -> IO () -> IO ()
Foreign/ForeignPtr.hs view
@@ -78,7 +78,7 @@ #ifdef __GLASGOW_HASKELL__ import GHC.Base-import GHC.IOBase+-- import GHC.IO import GHC.Num import GHC.Err ( undefined ) import GHC.ForeignPtr@@ -101,13 +101,10 @@ #ifndef __NHC__ newForeignPtr :: FinalizerPtr a -> Ptr a -> IO (ForeignPtr a) -- ^Turns a plain memory reference into a foreign pointer, and--- associates a finaliser with the reference. The finaliser will be executed--- after the last reference to the foreign object is dropped. Note that there--- is no guarantee on how soon the finaliser is executed after the last--- reference was dropped; this depends on the details of the Haskell storage--- manager. Indeed, there is no guarantee that the finalizer is executed at--- all; a program may exit with finalizers outstanding. (This is true--- of GHC, other implementations may give stronger guarantees).+-- associates a finaliser with the reference. The finaliser will be+-- executed after the last reference to the foreign object is dropped.+-- There is no guarantee of promptness, however the finalizer will be+-- executed before the program exits. newForeignPtr finalizer p = do fObj <- newForeignPtr_ p addForeignPtrFinalizer finalizer fObj
Foreign/Marshal/Alloc.hs view
@@ -40,7 +40,7 @@ #ifdef __GLASGOW_HASKELL__ import Foreign.ForeignPtr ( FinalizerPtr )-import GHC.IOBase+import GHC.IO.Exception import GHC.Real import GHC.Ptr import GHC.Err@@ -192,7 +192,10 @@ failWhenNULL name f = do addr <- f if addr == nullPtr-#if __GLASGOW_HASKELL__ || __HUGS__+#if __GLASGOW_HASKELL__+ then ioError (IOError Nothing ResourceExhausted name + "out of memory" Nothing Nothing)+#elif __HUGS__ then ioError (IOError Nothing ResourceExhausted name "out of memory" Nothing) #else
Foreign/Marshal/Array.hs view
@@ -68,7 +68,6 @@ import Foreign.Marshal.Utils (copyBytes, moveBytes) #ifdef __GLASGOW_HASKELL__-import GHC.IOBase import GHC.Num import GHC.List import GHC.Err
Foreign/Marshal/Error.hs view
@@ -37,7 +37,8 @@ #endif import GHC.Base import GHC.Num-import GHC.IOBase+-- import GHC.IO+import GHC.IO.Exception #endif -- exported functions
Foreign/Marshal/Pool.hs view
@@ -48,8 +48,8 @@ import GHC.Base ( Int, Monad(..), (.), not ) import GHC.Err ( undefined ) import GHC.Exception ( throw )-import GHC.IOBase ( IO, IORef, newIORef, readIORef, writeIORef,- block, unblock, catchAny )+import GHC.IO ( IO, block, unblock, catchAny )+import GHC.IORef ( IORef, newIORef, readIORef, writeIORef ) import GHC.List ( elem, length ) import GHC.Num ( Num(..) ) #else@@ -143,7 +143,7 @@ pooledReallocBytes :: Pool -> Ptr a -> Int -> IO (Ptr a) pooledReallocBytes (Pool pool) ptr size = do let cPtr = castPtr ptr- throwIf (not . (cPtr `elem`)) (\_ -> "pointer not in pool") (readIORef pool)+ _ <- throwIf (not . (cPtr `elem`)) (\_ -> "pointer not in pool") (readIORef pool) newPtr <- reallocBytes cPtr size ptrs <- readIORef pool writeIORef pool (newPtr : delete cPtr ptrs)
Foreign/Marshal/Utils.hs view
@@ -53,7 +53,6 @@ import Foreign.Marshal.Alloc ( malloc, alloca ) #ifdef __GLASGOW_HASKELL__-import GHC.IOBase import GHC.Real ( fromIntegral ) import GHC.Num import GHC.Base@@ -159,14 +158,14 @@ -- first (destination); the copied areas may /not/ overlap -- copyBytes :: Ptr a -> Ptr a -> Int -> IO ()-copyBytes dest src size = do memcpy dest src (fromIntegral size)+copyBytes dest src size = do _ <- memcpy dest src (fromIntegral size) return () -- |Copies the given number of bytes from the second area (source) into the -- first (destination); the copied areas /may/ overlap -- moveBytes :: Ptr a -> Ptr a -> Int -> IO ()-moveBytes dest src size = do memmove dest src (fromIntegral size)+moveBytes dest src size = do _ <- memmove dest src (fromIntegral size) return ()
Foreign/Ptr.hs view
@@ -50,7 +50,6 @@ #ifdef __GLASGOW_HASKELL__ import GHC.Ptr-import GHC.IOBase import GHC.Base import GHC.Num import GHC.Read@@ -59,7 +58,7 @@ import GHC.Enum import GHC.Word ( Word(..) ) -import Data.Int+-- import Data.Int import Data.Word #else import Control.Monad ( liftM )
Foreign/Storable.hs view
@@ -42,12 +42,12 @@ #ifdef __GLASGOW_HASKELL__ import GHC.Storable import GHC.Stable ( StablePtr )+import GHC.IO() -- Instance Monad IO import GHC.Num import GHC.Int import GHC.Word import GHC.Ptr import GHC.Err-import GHC.IOBase import GHC.Base #else import Data.Int
− Foreign/Storable.hs-boot
@@ -1,22 +0,0 @@--{-# OPTIONS_GHC -XNoImplicitPrelude #-}--module Foreign.Storable where--import GHC.Base-import GHC.Int-import GHC.Word--class Storable a--instance Storable Int8-instance Storable Int16-instance Storable Int32-instance Storable Int64-instance Storable Word8-instance Storable Word16-instance Storable Word32-instance Storable Word64-instance Storable Float-instance Storable Double-
GHC/Arr.lhs view
@@ -1,6 +1,7 @@ \begin{code} {-# OPTIONS_GHC -funbox-strict-fields #-} {-# LANGUAGE NoImplicitPrelude, NoBangPatterns #-}+{-# OPTIONS_HADDOCK hide #-} ----------------------------------------------------------------------------- -- | -- Module : GHC.Arr@@ -15,6 +16,7 @@ -- ----------------------------------------------------------------------------- +-- #hide module GHC.Arr where import GHC.Enum@@ -332,7 +334,6 @@ arrEleBottom :: a arrEleBottom = error "(Array.!): undefined array element" -{-# INLINE array #-} -- | Construct an array with the specified bounds and containing values -- for given indices within these bounds. --@@ -358,6 +359,7 @@ -- then the array is legal, but empty. Indexing an empty array always -- gives an array-bounds error, but 'bounds' still yields the bounds -- with which the array was constructed.+{-# INLINE array #-} array :: Ix i => (i,i) -- ^ a pair of /bounds/, each of the index type -- of the array. These bounds are the lowest and@@ -405,9 +407,9 @@ -- transformation on the list of elements; I guess it's impossible -- using mechanisms currently available. -{-# INLINE listArray #-} -- | Construct an array from a pair of bounds and a list of values in -- index order.+{-# INLINE listArray #-} listArray :: Ix i => (i,i) -> [e] -> Array i e listArray (l,u) es = runST (ST $ \s1# -> case safeRangeSize (l,u) of { n@(I# n#) ->@@ -420,8 +422,8 @@ case fillFromList 0# es s2# of { s3# -> done l u n marr# s3# }}}) -{-# INLINE (!) #-} -- | The value at the given index in an array.+{-# INLINE (!) #-} (!) :: Ix i => Array i e -> i -> e arr@(Array l u n _) ! i = unsafeAt arr $ safeIndex (l,u) n i @@ -433,44 +435,44 @@ {-# INLINE safeIndex #-} safeIndex :: Ix i => (i, i) -> Int -> i -> Int-safeIndex (l,u) n i = let i' = unsafeIndex (l,u) i+safeIndex (l,u) n i = let i' = index (l,u) i in if (0 <= i') && (i' < n) then i'- else error "Error in array index"+ else error ("Error in array index; " ++ show i' +++ " not in range [0.." ++ show n ++ ")") {-# INLINE unsafeAt #-} unsafeAt :: Ix i => Array i e -> Int -> e unsafeAt (Array _ _ _ arr#) (I# i#) = case indexArray# arr# i# of (# e #) -> e -{-# INLINE bounds #-} -- | The bounds with which an array was constructed.+{-# INLINE bounds #-} bounds :: Ix i => Array i e -> (i,i) bounds (Array l u _ _) = (l,u) -{-# INLINE numElements #-} -- | The number of elements in the array.+{-# INLINE numElements #-} numElements :: Ix i => Array i e -> Int numElements (Array _ _ n _) = n -{-# INLINE indices #-} -- | The list of indices of an array in ascending order.+{-# INLINE indices #-} indices :: Ix i => Array i e -> [i] indices (Array l u _ _) = range (l,u) -{-# INLINE elems #-} -- | The list of elements of an array in index order.+{-# INLINE elems #-} elems :: Ix i => Array i e -> [e] elems arr@(Array _ _ n _) = [unsafeAt arr i | i <- [0 .. n - 1]] -{-# INLINE assocs #-} -- | The list of associations of an array in index order.+{-# INLINE assocs #-} assocs :: Ix i => Array i e -> [(i, e)] assocs arr@(Array l u _ _) = [(i, arr ! i) | i <- range (l,u)] -{-# INLINE accumArray #-} -- | The 'accumArray' deals with repeated indices in the association -- list using an /accumulating function/ which combines the values of -- associations with the same index.@@ -485,6 +487,7 @@ -- the values, as well as the indices, in the association list. Thus, -- unlike ordinary arrays built with 'array', accumulated arrays should -- not in general be recursive.+{-# INLINE accumArray #-} accumArray :: Ix i => (e -> a -> e) -- ^ accumulating function -> e -- ^ initial value@@ -514,7 +517,6 @@ case writeArray# marr# i# (f old new) s2# of s3# -> next s3# -{-# INLINE (//) #-} -- | Constructs an array identical to the first argument except that it has -- been updated by the associations in the right argument. -- For example, if @m@ is a 1-origin, @n@ by @n@ matrix, then@@ -526,6 +528,7 @@ -- Repeated indices in the association list are handled as for 'array': -- Haskell 98 specifies that the resulting array is undefined (i.e. bottom), -- but GHC's implementation uses the last association for each index.+{-# INLINE (//) #-} (//) :: Ix i => Array i e -> [(i, e)] -> Array i e arr@(Array l u n _) // ies = unsafeReplace arr [(safeIndex (l,u) n i, e) | (i, e) <- ies]@@ -536,13 +539,13 @@ STArray l u n marr# <- thawSTArray arr ST (foldr (fill marr#) (done l u n marr#) ies)) -{-# INLINE accum #-} -- | @'accum' f@ takes an array and an association list and accumulates -- pairs from the list into the array with the accumulating function @f@. -- Thus 'accumArray' can be defined using 'accum': -- -- > accumArray f z b = accum f (array b [(i, z) | i <- range b]) --+{-# INLINE accum #-} accum :: Ix i => (e -> a -> e) -> Array i e -> [(i, a)] -> Array i e accum f arr@(Array l u n _) ies = unsafeAccum f arr [(safeIndex (l,u) n i, e) | (i, e) <- ies]@@ -558,13 +561,13 @@ amap f arr@(Array l u n _) = unsafeArray' (l,u) n [(i, f (unsafeAt arr i)) | i <- [0 .. n - 1]] -{-# INLINE ixmap #-} -- | 'ixmap' allows for transformations on array indices. -- It may be thought of as providing function composition on the right -- with the mapping that the original array embodies. -- -- A similar transformation of array values may be achieved using 'fmap' -- from the 'Array' instance of the 'Functor' class.+{-# INLINE ixmap #-} ixmap :: (Ix i, Ix j) => (i,i) -> (i -> j) -> Array j e -> Array i e ixmap (l,u) f arr = array (l,u) [(i, arr ! f i) | i <- range (l,u)]
GHC/Base.lhs view
@@ -101,10 +101,19 @@ import GHC.Generics import GHC.Ordering import GHC.Prim+import {-# SOURCE #-} GHC.Show import {-# SOURCE #-} GHC.Err+import {-# SOURCE #-} GHC.IO (failIO) +-- These two are not strictly speaking required by this module, but they are+-- implicit dependencies whenever () or tuples are mentioned, so adding them+-- as imports here helps to get the dependencies right in the new build system.+import GHC.Tuple ()+import GHC.Unit ()+ infixr 9 . infixr 5 +++infixl 4 <$ infixl 1 >>, >>= infixr 0 $ @@ -168,6 +177,12 @@ class Functor f where fmap :: (a -> b) -> f a -> f b + -- | Replace all locations in the input with the same value.+ -- The default definition is @'fmap' . 'const'@, but this may be+ -- overridden with a more efficient version.+ (<$) :: a -> f b -> f a+ (<$) = fmap . const+ {- | The 'Monad' class defines the basic operations over a /monad/, a concept from a branch of mathematics known as /category theory/. From the perspective of a Haskell programmer, however, it is best to@@ -529,8 +544,10 @@ -- | The 'Prelude.toEnum' method restricted to the type 'Data.Char.Char'. chr :: Int -> Char-chr (I# i#) | int2Word# i# `leWord#` int2Word# 0x10FFFF# = C# (chr# i#)- | otherwise = error "Prelude.chr: bad argument"+chr i@(I# i#)+ | int2Word# i# `leWord#` int2Word# 0x10FFFF# = C# (chr# i#)+ | otherwise+ = error ("Prelude.chr: bad argument: " ++ showSignedInt (I# 9#) i "") unsafeChr :: Int -> Char unsafeChr (I# i#) = C# (chr# i#)@@ -701,6 +718,38 @@ %********************************************************* %* *+\subsection{@Functor@ and @Monad@ instances for @IO@}+%* *+%*********************************************************++\begin{code}+instance Functor IO where+ fmap f x = x >>= (return . f)++instance Monad IO where+ {-# INLINE return #-}+ {-# INLINE (>>) #-}+ {-# INLINE (>>=) #-}+ m >> k = m >>= \ _ -> k+ return = returnIO+ (>>=) = bindIO+ fail s = GHC.IO.failIO s++returnIO :: a -> IO a+returnIO x = IO $ \ s -> (# s, x #)++bindIO :: IO a -> (a -> IO b) -> IO b+bindIO (IO m) k = IO $ \ s -> case m s of (# new_s, a #) -> unIO (k a) new_s++thenIO :: IO a -> IO b -> IO b+thenIO (IO m) k = IO $ \ s -> case m s of (# new_s, _ #) -> unIO k new_s++unIO :: IO a -> (State# RealWorld -> (# State# RealWorld, a #))+unIO (IO a) = a+\end{code}++%*********************************************************+%* * \subsection{@getTag@} %* * %*********************************************************@@ -747,7 +796,7 @@ (x# <# 0#) && (y# ># 0#) = if r# /=# 0# then r# +# y# else 0# | otherwise = r# where- r# = x# `remInt#` y#+ !r# = x# `remInt#` y# \end{code} Definitions of the boxed PrimOps; these will be@@ -767,7 +816,7 @@ {-# INLINE remInt #-} {-# INLINE negateInt #-} -plusInt, minusInt, timesInt, quotInt, remInt, divInt, modInt, gcdInt :: Int -> Int -> Int+plusInt, minusInt, timesInt, quotInt, remInt, divInt, modInt :: Int -> Int -> Int (I# x) `plusInt` (I# y) = I# (x +# y) (I# x) `minusInt` (I# y) = I# (x -# y) (I# x) `timesInt` (I# y) = I# (x *# y)@@ -787,17 +836,6 @@ "1# *# x#" forall x#. 1# *# x# = x# #-} -gcdInt (I# a) (I# b) = g a b- where g 0# 0# = error "GHC.Base.gcdInt: gcd 0 0 is undefined"- g 0# _ = I# absB- g _ 0# = I# absA- g _ _ = I# (gcdInt# absA absB)-- absInt x = if x <# 0# then negateInt# x else x-- absA = absInt a- absB = absInt b- negateInt :: Int -> Int negateInt (I# x) = I# (negateInt# x) @@ -917,7 +955,11 @@ \begin{code} unpackCString# :: Addr# -> [Char]-{-# NOINLINE [1] unpackCString# #-}+{-# NOINLINE unpackCString# #-}+ -- There's really no point in inlining this, ever, cos+ -- the loop doesn't specialise in an interesting+ -- But it's pretty small, so there's a danger that+ -- it'll be inlined at every literal, which is a waste unpackCString# addr = unpack 0# where@@ -925,9 +967,11 @@ | ch `eqChar#` '\0'# = [] | otherwise = C# ch : unpack (nh +# 1#) where- ch = indexCharOffAddr# addr nh+ !ch = indexCharOffAddr# addr nh unpackAppendCString# :: Addr# -> [Char] -> [Char]+{-# NOINLINE unpackAppendCString# #-}+ -- See the NOINLINE note on unpackCString# unpackAppendCString# addr rest = unpack 0# where@@ -935,11 +979,13 @@ | ch `eqChar#` '\0'# = rest | otherwise = C# ch : unpack (nh +# 1#) where- ch = indexCharOffAddr# addr nh+ !ch = indexCharOffAddr# addr nh unpackFoldrCString# :: Addr# -> (Char -> a -> a) -> a -> a {-# NOINLINE [0] unpackFoldrCString# #-}--- Don't inline till right at the end;+-- Unlike unpackCString#, there *is* some point in inlining unpackFoldrCString#, +-- because we get better code for the function call.+-- However, don't inline till right at the end; -- usually the unpack-list rule turns it into unpackCStringList -- It also has a BuiltInRule in PrelRules.lhs: -- unpackFoldrCString# "foo" c (unpackFoldrCString# "baz" c n)@@ -951,7 +997,7 @@ | ch `eqChar#` '\0'# = z | otherwise = C# ch `f` unpack (nh +# 1#) where- ch = indexCharOffAddr# addr nh+ !ch = indexCharOffAddr# addr nh unpackCStringUtf8# :: Addr# -> [Char] unpackCStringUtf8# addr @@ -976,7 +1022,7 @@ (ord# (indexCharOffAddr# addr (nh +# 3#)) -# 0x80#))) : unpack (nh +# 4#) where- ch = indexCharOffAddr# addr nh+ !ch = indexCharOffAddr# addr nh unpackNBytes# :: Addr# -> Int# -> [Char] unpackNBytes# _addr 0# = []@@ -989,7 +1035,7 @@ ch -> unpack (C# ch : acc) (i# -# 1#) {-# RULES-"unpack" [~1] forall a . unpackCString# a = build (unpackFoldrCString# a)+"unpack" [~1] forall a . unpackCString# a = build (unpackFoldrCString# a) "unpack-list" [1] forall a . unpackFoldrCString# a (:) [] = unpackCString# a "unpack-append" forall a n . unpackFoldrCString# a (:) n = unpackAppendCString# a n
GHC/Conc.lhs view
@@ -37,6 +37,7 @@ , throwTo -- :: ThreadId -> Exception -> IO () , par -- :: a -> b -> b , pseq -- :: a -> b -> b+ , runSparks , yield -- :: IO () , labelThread -- :: ThreadId -> String -> IO () @@ -49,17 +50,6 @@ , threadWaitRead -- :: Int -> IO () , threadWaitWrite -- :: Int -> IO () - -- * MVars- , MVar(..)- , newMVar -- :: a -> IO (MVar a)- , newEmptyMVar -- :: IO (MVar a)- , takeMVar -- :: MVar a -> IO a- , putMVar -- :: MVar a -> a -> IO ()- , tryTakeMVar -- :: MVar a -> IO (Maybe a)- , tryPutMVar -- :: MVar a -> a -> IO Bool- , isEmptyMVar -- :: MVar a -> IO Bool- , addMVarFinalizer -- :: MVar a -> IO () -> IO ()- -- * TVars , STM(..) , atomically -- :: STM a -> IO a@@ -72,10 +62,12 @@ , newTVar -- :: a -> STM (TVar a) , newTVarIO -- :: a -> STM (TVar a) , readTVar -- :: TVar a -> STM a+ , readTVarIO -- :: TVar a -> IO a , writeTVar -- :: a -> TVar a -> STM () , unsafeIOToSTM -- :: IO a -> STM a -- * Miscellaneous+ , withMVar #ifdef mingw32_HOST_OS , asyncRead -- :: Int -> Int -> Int -> Ptr a -> IO (Int, Int) , asyncWrite -- :: Int -> Int -> Int -> Ptr a -> IO (Int, Int)@@ -112,35 +104,43 @@ import Foreign import Foreign.C +#ifdef mingw32_HOST_OS+import Data.Typeable+#endif+ #ifndef mingw32_HOST_OS import Data.Dynamic-import Control.Monad #endif+import Control.Monad import Data.Maybe import GHC.Base-import {-# SOURCE #-} GHC.Handle-import GHC.IOBase+#ifndef mingw32_HOST_OS+import GHC.Debug+#endif+import {-# SOURCE #-} GHC.IO.Handle ( hFlush )+import {-# SOURCE #-} GHC.IO.Handle.FD ( stdout )+import GHC.IO+import GHC.IO.Exception+import GHC.Exception+import GHC.IORef+import GHC.MVar import GHC.Num ( Num(..) ) import GHC.Real ( fromIntegral ) #ifndef mingw32_HOST_OS+import GHC.IOArray import GHC.Arr ( inRange ) #endif #ifdef mingw32_HOST_OS import GHC.Real ( div )-import GHC.Ptr ( plusPtr, FunPtr(..) )+import GHC.Ptr #endif #ifdef mingw32_HOST_OS import GHC.Read ( Read ) import GHC.Enum ( Enum ) #endif-import GHC.Exception ( SomeException(..), throw ) import GHC.Pack ( packCString# )-import GHC.Ptr ( Ptr(..) )-import GHC.STRef import GHC.Show ( Show(..), showString )-import Data.Typeable-import GHC.Err infixr 0 `par`, `pseq` \end{code}@@ -253,8 +253,11 @@ n <- peek n_capabilities return (fromIntegral n) +#if defined(mingw32_HOST_OS) && defined(__PIC__)+foreign import ccall "_imp__n_capabilities" n_capabilities :: Ptr CInt+#else foreign import ccall "&n_capabilities" n_capabilities :: Ptr CInt-+#endif childHandler :: SomeException -> IO () childHandler err = catchException (real_handler err) childHandler @@ -262,9 +265,9 @@ real_handler se@(SomeException ex) = -- ignore thread GC and killThread exceptions: case cast ex of- Just BlockedOnDeadMVar -> return ()+ Just BlockedIndefinitelyOnMVar -> return () _ -> case cast ex of- Just BlockedIndefinitely -> return ()+ Just BlockedIndefinitelyOnSTM -> return () _ -> case cast ex of Just ThreadKilled -> return () _ -> case cast ex of@@ -346,8 +349,8 @@ labelThread :: ThreadId -> String -> IO () labelThread (ThreadId t) str = IO $ \ s ->- let ps = packCString# str- adr = byteArrayContents# ps in+ let !ps = packCString# str+ !adr = byteArrayContents# ps in case (labelThread# t adr s) of s1 -> (# s1, () #) -- Nota Bene: 'pseq' used to be 'seq'@@ -369,6 +372,13 @@ par :: a -> b -> b par x y = case (par# x) of { _ -> lazy y } +-- | Internal function used by the RTS to run sparks.+runSparks :: IO ()+runSparks = IO loop+ where loop s = case getSpark# s of+ (# s', n, p #) ->+ if n ==# 0# then (# s', () #)+ else p `seq` loop s' data BlockReason = BlockedOnMVar@@ -532,7 +542,7 @@ -- of those points then the transaction violating it is aborted -- and the exception raised by the invariant is propagated. alwaysSucceeds :: STM a -> STM ()-alwaysSucceeds i = do ( do i ; retry ) `orElse` ( return () ) +alwaysSucceeds i = do ( i >> retry ) `orElse` ( return () ) checkInv i -- | always is a variant of alwaysSucceeds in which the invariant is@@ -565,6 +575,16 @@ case newTVar# val s1# of (# s2#, tvar# #) -> (# s2#, TVar tvar# #) +-- |Return the current value stored in a TVar.+-- This is equivalent to+--+-- > readTVarIO = atomically . readTVar+--+-- but works much faster, because it doesn't perform a complete+-- transaction, it just reads the current value of the 'TVar'.+readTVarIO :: TVar a -> IO a+readTVarIO (TVar tvar#) = IO $ \s# -> readTVarIO# tvar# s#+ -- |Return the current value stored in a TVar readTVar :: TVar a -> STM a readTVar (TVar tvar#) = STM $ \s# -> readTVar# tvar# s#@@ -577,111 +597,28 @@ \end{code} -%************************************************************************-%* *-\subsection[mvars]{M-Structures}-%* *-%************************************************************************--M-Vars are rendezvous points for concurrent threads. They begin-empty, and any attempt to read an empty M-Var blocks. When an M-Var-is written, a single blocked thread may be freed. Reading an M-Var-toggles its state from full back to empty. Therefore, any value-written to an M-Var may only be read once. Multiple reads and writes-are allowed, but there must be at least one read between any two-writes.+MVar utilities \begin{code}---Defined in IOBase to avoid cycle: data MVar a = MVar (SynchVar# RealWorld a)---- |Create an 'MVar' which is initially empty.-newEmptyMVar :: IO (MVar a)-newEmptyMVar = IO $ \ s# ->- case newMVar# s# of- (# s2#, svar# #) -> (# s2#, MVar svar# #)---- |Create an 'MVar' which contains the supplied value.-newMVar :: a -> IO (MVar a)-newMVar value =- newEmptyMVar >>= \ mvar ->- putMVar mvar value >>- return mvar---- |Return the contents of the 'MVar'. If the 'MVar' is currently--- empty, 'takeMVar' will wait until it is full. After a 'takeMVar', --- the 'MVar' is left empty.--- --- There are two further important properties of 'takeMVar':------ * 'takeMVar' is single-wakeup. That is, if there are multiple--- threads blocked in 'takeMVar', and the 'MVar' becomes full,--- only one thread will be woken up. The runtime guarantees that--- the woken thread completes its 'takeMVar' operation.------ * When multiple threads are blocked on an 'MVar', they are--- woken up in FIFO order. This is useful for providing--- fairness properties of abstractions built using 'MVar's.----takeMVar :: MVar a -> IO a-takeMVar (MVar mvar#) = IO $ \ s# -> takeMVar# mvar# s#---- |Put a value into an 'MVar'. If the 'MVar' is currently full,--- 'putMVar' will wait until it becomes empty.------ There are two further important properties of 'putMVar':------ * 'putMVar' is single-wakeup. That is, if there are multiple--- threads blocked in 'putMVar', and the 'MVar' becomes empty,--- only one thread will be woken up. The runtime guarantees that--- the woken thread completes its 'putMVar' operation.------ * When multiple threads are blocked on an 'MVar', they are--- woken up in FIFO order. This is useful for providing--- fairness properties of abstractions built using 'MVar's.----putMVar :: MVar a -> a -> IO ()-putMVar (MVar mvar#) x = IO $ \ s# ->- case putMVar# mvar# x s# of- s2# -> (# s2#, () #)---- |A non-blocking version of 'takeMVar'. The 'tryTakeMVar' function--- returns immediately, with 'Nothing' if the 'MVar' was empty, or--- @'Just' a@ if the 'MVar' was full with contents @a@. After 'tryTakeMVar',--- the 'MVar' is left empty.-tryTakeMVar :: MVar a -> IO (Maybe a)-tryTakeMVar (MVar m) = IO $ \ s ->- case tryTakeMVar# m s of- (# s', 0#, _ #) -> (# s', Nothing #) -- MVar is empty- (# s', _, a #) -> (# s', Just a #) -- MVar is full---- |A non-blocking version of 'putMVar'. The 'tryPutMVar' function--- attempts to put the value @a@ into the 'MVar', returning 'True' if--- it was successful, or 'False' otherwise.-tryPutMVar :: MVar a -> a -> IO Bool-tryPutMVar (MVar mvar#) x = IO $ \ s# ->- case tryPutMVar# mvar# x s# of- (# s, 0# #) -> (# s, False #)- (# s, _ #) -> (# s, True #)---- |Check whether a given 'MVar' is empty.------ Notice that the boolean value returned is just a snapshot of--- the state of the MVar. By the time you get to react on its result,--- the MVar may have been filled (or emptied) - so be extremely--- careful when using this operation. Use 'tryTakeMVar' instead if possible.-isEmptyMVar :: MVar a -> IO Bool-isEmptyMVar (MVar mv#) = IO $ \ s# -> - case isEmptyMVar# mv# s# of- (# s2#, flg #) -> (# s2#, not (flg ==# 0#) #)+withMVar :: MVar a -> (a -> IO b) -> IO b+withMVar m io = + block $ do+ a <- takeMVar m+ b <- catchAny (unblock (io a))+ (\e -> do putMVar m a; throw e)+ putMVar m a+ return b --- |Add a finalizer to an 'MVar' (GHC only). See "Foreign.ForeignPtr" and--- "System.Mem.Weak" for more about finalizers.-addMVarFinalizer :: MVar a -> IO () -> IO ()-addMVarFinalizer (MVar m) finalizer = - IO $ \s -> case mkWeak# m () finalizer s of { (# s1, _ #) -> (# s1, () #) }+modifyMVar_ :: MVar a -> (a -> IO a) -> IO ()+modifyMVar_ m io =+ block $ do+ a <- takeMVar m+ a' <- catchAny (unblock (io a))+ (\e -> do putMVar m a; throw e)+ putMVar m a'+ return () \end{code} - %************************************************************************ %* * \subsection{Thread waiting}@@ -817,23 +754,6 @@ -- around the scheduler loop. Furthermore, the scheduler can be simplified -- by not having to check for completed IO requests. --- Issues, possible problems:------ - we might want bound threads to just do the blocking--- operation rather than communicating with the IO manager--- thread. This would prevent simgle-threaded programs which do--- IO from requiring multiple OS threads. However, it would also--- prevent bound threads waiting on IO from being killed or sent--- exceptions.------ - Apprently exec() doesn't work on Linux in a multithreaded program.--- I couldn't repeat this.------ - How do we handle signal delivery in the multithreaded RTS?------ - forkProcess will kill the IO manager thread. Let's just--- hope we don't need to do any blocking IO between fork & exec.- #ifndef mingw32_HOST_OS data IOReq = Read {-# UNPACK #-} !Fd {-# UNPACK #-} !(MVar ())@@ -845,25 +765,52 @@ | DelaySTM {-# UNPACK #-} !USecs {-# UNPACK #-} !(TVar Bool) #ifndef mingw32_HOST_OS+{-# NOINLINE pendingEvents #-} pendingEvents :: IORef [IOReq]+pendingEvents = unsafePerformIO $ do+ m <- newIORef []+ sharedCAF m getOrSetGHCConcPendingEventsStore++foreign import ccall unsafe "getOrSetGHCConcPendingEventsStore"+ getOrSetGHCConcPendingEventsStore :: Ptr a -> IO (Ptr a) #endif-pendingDelays :: IORef [DelayReq]- -- could use a strict list or array here-{-# NOINLINE pendingEvents #-}+ {-# NOINLINE pendingDelays #-}-(pendingEvents,pendingDelays) = unsafePerformIO $ do- startIOManagerThread- reqs <- newIORef []- dels <- newIORef []- return (reqs, dels)- -- the first time we schedule an IO request, the service thread- -- will be created (cool, huh?)+pendingDelays :: IORef [DelayReq]+pendingDelays = unsafePerformIO $ do+ m <- newIORef []+ sharedCAF m getOrSetGHCConcPendingDelaysStore +foreign import ccall unsafe "getOrSetGHCConcPendingDelaysStore"+ getOrSetGHCConcPendingDelaysStore :: Ptr a -> IO (Ptr a)++{-# NOINLINE ioManagerThread #-}+ioManagerThread :: MVar (Maybe ThreadId)+ioManagerThread = unsafePerformIO $ do+ m <- newMVar Nothing+ sharedCAF m getOrSetGHCConcIOManagerThreadStore++foreign import ccall unsafe "getOrSetGHCConcIOManagerThreadStore"+ getOrSetGHCConcIOManagerThreadStore :: Ptr a -> IO (Ptr a)+ ensureIOManagerIsRunning :: IO () ensureIOManagerIsRunning - | threaded = seq pendingEvents $ return ()+ | threaded = startIOManagerThread | otherwise = return () +startIOManagerThread :: IO ()+startIOManagerThread = do+ modifyMVar_ ioManagerThread $ \old -> do+ let create = do t <- forkIO ioManager; return (Just t)+ case old of+ Nothing -> create+ Just t -> do+ s <- threadStatus t+ case s of+ ThreadFinished -> create+ ThreadDied -> create+ _other -> return (Just t)+ insertDelay :: DelayReq -> [DelayReq] -> [DelayReq] insertDelay d [] = [d] insertDelay d1 ds@(d2 : rest)@@ -876,31 +823,51 @@ type USecs = Word64 --- XXX: move into GHC.IOBase from Data.IORef?-atomicModifyIORef :: IORef a -> (a -> (a,b)) -> IO b-atomicModifyIORef (IORef (STRef r#)) f = IO $ \s -> atomicModifyMutVar# r# f s- foreign import ccall unsafe "getUSecOfDay" getUSecOfDay :: IO USecs -prodding :: IORef Bool {-# NOINLINE prodding #-}-prodding = unsafePerformIO (newIORef False)+prodding :: IORef Bool+prodding = unsafePerformIO $ do+ r <- newIORef False+ sharedCAF r getOrSetGHCConcProddingStore +foreign import ccall unsafe "getOrSetGHCConcProddingStore"+ getOrSetGHCConcProddingStore :: Ptr a -> IO (Ptr a)+ prodServiceThread :: IO () prodServiceThread = do- was_set <- atomicModifyIORef prodding (\a -> (True,a))+ was_set <- readIORef prodding+ writeIORef prodding True+ -- no need for atomicModifyIORef, extra prods are harmless. if (not (was_set)) then wakeupIOManager else return () +-- Machinery needed to ensure that we only have one copy of certain+-- CAFs in this module even when the base package is present twice, as+-- it is when base is dynamically loaded into GHCi. The RTS keeps+-- track of the single true value of the CAF, so even when the CAFs in+-- the dynamically-loaded base package are reverted, nothing bad+-- happens.+--+sharedCAF :: a -> (Ptr a -> IO (Ptr a)) -> IO a+sharedCAF a get_or_set =+ block $ do+ stable_ref <- newStablePtr a+ let ref = castPtr (castStablePtrToPtr stable_ref)+ ref2 <- get_or_set ref+ if ref==ref2+ then return a+ else do freeStablePtr stable_ref+ deRefStablePtr (castPtrToStablePtr (castPtr ref2))+ #ifdef mingw32_HOST_OS -- ---------------------------------------------------------------------------- -- Windows IO manager thread -startIOManagerThread :: IO ()-startIOManagerThread = do+ioManager :: IO ()+ioManager = do wakeup <- c_getIOManagerEvent- forkIO $ service_loop wakeup []- return ()+ service_loop wakeup [] service_loop :: HANDLE -- read end of pipe -> [DelayReq] -- current delay requests@@ -925,9 +892,7 @@ _ | r2 == io_MANAGER_DIE -> return True 0 -> return False -- spurious wakeup _ -> do start_console_handler (r2 `shiftR` 1); return False- if exit- then return ()- else service_cont wakeup delays'+ unless exit $ service_cont wakeup delays' _other -> service_cont wakeup delays' -- probably timeout @@ -955,7 +920,7 @@ start_console_handler r = case toWin32ConsoleEvent r of Just x -> withMVar win32ConsoleHandler $ \handler -> do- forkIO (handler x)+ _ <- forkIO (handler x) return () Nothing -> return () @@ -972,15 +937,8 @@ win32ConsoleHandler :: MVar (ConsoleEvent -> IO ()) win32ConsoleHandler = unsafePerformIO (newMVar (error "win32ConsoleHandler")) --- XXX Is this actually needed?-stick :: IORef HANDLE-{-# NOINLINE stick #-}-stick = unsafePerformIO (newIORef nullPtr)- wakeupIOManager :: IO ()-wakeupIOManager = do - _hdl <- readIORef stick- c_sendIOManagerEvent io_MANAGER_WAKEUP+wakeupIOManager = c_sendIOManagerEvent io_MANAGER_WAKEUP -- Walk the queue of pending delays, waking up any that have passed -- and return the smallest delay to wait for. The queue of pending@@ -1029,23 +987,21 @@ -- ---------------------------------------------------------------------------- -- Unix IO manager thread, using select() -startIOManagerThread :: IO ()-startIOManagerThread = do+ioManager :: IO ()+ioManager = do allocaArray 2 $ \fds -> do- throwErrnoIfMinus1 "startIOManagerThread" (c_pipe fds)+ throwErrnoIfMinus1_ "startIOManagerThread" (c_pipe fds) rd_end <- peekElemOff fds 0 wr_end <- peekElemOff fds 1- setNonBlockingFD wr_end -- writes happen in a signal handler, we- -- don't want them to block.+ setNonBlockingFD wr_end True -- writes happen in a signal handler, we+ -- don't want them to block. setCloseOnExec rd_end setCloseOnExec wr_end- writeIORef stick (fromIntegral wr_end) c_setIOManagerPipe wr_end- forkIO $ do- allocaBytes sizeofFdSet $ \readfds -> do- allocaBytes sizeofFdSet $ \writefds -> do - allocaBytes sizeofTimeVal $ \timeval -> do- service_loop (fromIntegral rd_end) readfds writefds timeval [] []+ allocaBytes sizeofFdSet $ \readfds -> do+ allocaBytes sizeofFdSet $ \writefds -> do + allocaBytes sizeofTimeVal $ \timeval -> do+ service_loop (fromIntegral rd_end) readfds writefds timeval [] [] return () service_loop@@ -1106,7 +1062,8 @@ if b == 0 then return False else alloca $ \p -> do - c_read (fromIntegral wakeup) p 1+ warnErrnoIfMinus1_ "service_loop" $+ c_read (fromIntegral wakeup) p 1 s <- peek p case s of _ | s == io_MANAGER_WAKEUP -> return False@@ -1125,25 +1082,20 @@ runHandlers' fp (fromIntegral s) return False - if exit then return () else do+ unless exit $ do - atomicModifyIORef prodding (\_ -> (False,False))+ atomicModifyIORef prodding (\_ -> (False, ())) reqs' <- if wakeup_all then do wakeupAll reqs; return [] else completeRequests reqs readfds writefds [] service_loop wakeup readfds writefds ptimeval reqs' delays' -io_MANAGER_WAKEUP, io_MANAGER_DIE, io_MANAGER_SYNC :: CChar+io_MANAGER_WAKEUP, io_MANAGER_DIE, io_MANAGER_SYNC :: Word8 io_MANAGER_WAKEUP = 0xff io_MANAGER_DIE = 0xfe io_MANAGER_SYNC = 0xfd --- | the stick is for poking the IO manager with-stick :: IORef Fd-{-# NOINLINE stick #-}-stick = unsafePerformIO (newIORef 0)- {-# NOINLINE sync #-} sync :: IORef [MVar ()] sync = unsafePerformIO (newIORef [])@@ -1153,16 +1105,11 @@ syncIOManager = do m <- newEmptyMVar atomicModifyIORef sync (\old -> (m:old,()))- fd <- readIORef stick- with io_MANAGER_SYNC $ \pbuf -> do - c_write (fromIntegral fd) pbuf 1; return ()+ c_ioManagerSync takeMVar m -wakeupIOManager :: IO ()-wakeupIOManager = do- fd <- readIORef stick- with io_MANAGER_WAKEUP $ \pbuf -> do - c_write (fromIntegral fd) pbuf 1; return ()+foreign import ccall unsafe "ioManagerSync" c_ioManagerSync :: IO ()+foreign import ccall unsafe "ioManagerWakeup" wakeupIOManager :: IO () -- For the non-threaded RTS runHandlers :: Ptr Word8 -> Int -> IO ()@@ -1182,8 +1129,20 @@ else do handler <- unsafeReadIOArray arr int case handler of Nothing -> return ()- Just (f,_) -> do forkIO (f p_info); return ()+ Just (f,_) -> do _ <- forkIO (f p_info)+ return () +warnErrnoIfMinus1_ :: Num a => String -> IO a -> IO ()+warnErrnoIfMinus1_ what io+ = do r <- io+ when (r == -1) $ do+ errno <- getErrno+ str <- strerror errno >>= peekCString+ when (r == -1) $+ debugErrLn ("Warning: " ++ what ++ " failed: " ++ str)++foreign import ccall unsafe "string.h" strerror :: Errno -> IO (Ptr CChar)+ foreign import ccall "setIOManagerPipe" c_setIOManagerPipe :: CInt -> IO () @@ -1203,8 +1162,12 @@ signal_handlers :: MVar (IOArray Int (Maybe (HandlerFun,Dynamic))) signal_handlers = unsafePerformIO $ do arr <- newIOArray (0,maxSig) Nothing- newMVar arr+ m <- newMVar arr+ sharedCAF m getOrSetGHCConcSignalHandlerStore +foreign import ccall unsafe "getOrSetGHCConcSignalHandlerStore"+ getOrSetGHCConcSignalHandlerStore :: Ptr a -> IO (Ptr a)+ setHandler :: Signal -> Maybe (HandlerFun,Dynamic) -> IO (Maybe (HandlerFun,Dynamic)) setHandler sig handler = do let int = fromIntegral sig@@ -1305,7 +1268,7 @@ data CFdSet -foreign import ccall safe "select"+foreign import ccall safe "__hscore_select" c_select :: CInt -> Ptr CFdSet -> Ptr CFdSet -> Ptr CFdSet -> Ptr CTimeVal -> IO CInt @@ -1335,14 +1298,13 @@ #endif -reportStackOverflow :: IO a-reportStackOverflow = do callStackOverflowHook; return undefined+reportStackOverflow :: IO ()+reportStackOverflow = callStackOverflowHook -reportError :: SomeException -> IO a+reportError :: SomeException -> IO () reportError ex = do handler <- getUncaughtExceptionHandler handler ex- return undefined -- SUP: Are the hooks allowed to re-enter Haskell land? If so, remove -- the unsafe below.@@ -1376,13 +1338,4 @@ getUncaughtExceptionHandler :: IO (SomeException -> IO ()) getUncaughtExceptionHandler = readIORef uncaughtExceptionHandler --withMVar :: MVar a -> (a -> IO b) -> IO b-withMVar m io = - block $ do- a <- takeMVar m- b <- catchAny (unblock (io a))- (\e -> do putMVar m a; throw e)- putMVar m a- return b \end{code}
GHC/ConsoleHandler.hs view
@@ -18,7 +18,6 @@ module GHC.ConsoleHandler #if !defined(mingw32_HOST_OS) && !defined(__HADDOCK__) where-import Prelude -- necessary to get dependencies right #else /* whole file */ ( Handler(..) , installHandler@@ -27,18 +26,26 @@ ) where {--#include "Signals.h"+#include "rts/Signals.h" -} -import Prelude -- necessary to get dependencies right- import Foreign import Foreign.C-import GHC.IOBase+import GHC.IO.FD+import GHC.IO.Exception+import GHC.IO.Handle.Types+import GHC.IO.Handle.Internals import GHC.Conc-import GHC.Handle-import Control.Exception (onException)+import Control.Concurrent.MVar+import Data.Typeable +#ifdef mingw32_HOST_OS+import Data.Maybe+import GHC.Base+import GHC.Num+import GHC.Real+#endif+ data Handler = Default | Ignore@@ -134,19 +141,16 @@ flushConsole :: Handle -> IO () flushConsole h =- wantReadableHandle "flushConsole" h $ \ h_ ->- throwErrnoIfMinus1Retry_ "flushConsole"- (flush_console_fd (fromIntegral (haFD h_)))+ wantReadableHandle_ "flushConsole" h $ \ Handle__{haDevice=dev} ->+ case cast dev of+ Nothing -> ioException $+ IOError (Just h) IllegalOperation "flushConsole"+ "handle is not a file descriptor" Nothing Nothing+ Just fd -> do+ throwErrnoIfMinus1Retry_ "flushConsole" $+ flush_console_fd (fromIntegral (fdFD fd)) foreign import ccall unsafe "consUtils.h flush_input_console__" flush_console_fd :: CInt -> IO CInt --- XXX Copied from Control.Concurrent.MVar-modifyMVar :: MVar a -> (a -> IO (a,b)) -> IO b-modifyMVar m io =- block $ do- a <- takeMVar m- (a',b) <- unblock (io a) `onException` putMVar m a- putMVar m a'- return b #endif /* mingw32_HOST_OS */
+ GHC/Constants.hs view
@@ -0,0 +1,9 @@++module GHC.Constants where++import Prelude++-- We use stage1 here, because that's guaranteed to exist+#include "../../../compiler/stage1/ghc_boot_platform.h"++#include "../../../includes/HaskellConstants.hs"
GHC/Desugar.hs view
@@ -13,11 +13,11 @@ ----------------------------------------------------------------------------- -- #hide-module GHC.Desugar ((>>>)) where+module GHC.Desugar ((>>>), AnnotationWrapper(..), toAnnotationWrapper) where import Control.Arrow (Arrow(..)) import Control.Category ((.))-import Prelude hiding ((.))+import Data.Data (Data) -- A version of Control.Category.>>> overloaded on Arrow #ifndef __HADDOCK__@@ -29,3 +29,8 @@ -- arrows stuff needs reworking anyway! f >>> g = g . f +-- A wrapper data type that lets the typechecker get at the appropriate dictionaries for an annotation+data AnnotationWrapper = forall a. (Data a) => AnnotationWrapper a++toAnnotationWrapper :: (Data a) => a -> AnnotationWrapper+toAnnotationWrapper what = AnnotationWrapper what
GHC/Enum.lhs view
@@ -368,14 +368,14 @@ | delta >=# 0# = go_up_char_fb c n x1 delta 0x10FFFF# | otherwise = go_dn_char_fb c n x1 delta 0# where- delta = x2 -# x1+ !delta = x2 -# x1 efdChar :: Int# -> Int# -> String efdChar x1 x2 | delta >=# 0# = go_up_char_list x1 delta 0x10FFFF# | otherwise = go_dn_char_list x1 delta 0# where- delta = x2 -# x1+ !delta = x2 -# x1 {-# NOINLINE [0] efdtCharFB #-} efdtCharFB :: (Char -> a -> a) -> a -> Int# -> Int# -> Int# -> a@@ -383,14 +383,14 @@ | delta >=# 0# = go_up_char_fb c n x1 delta lim | otherwise = go_dn_char_fb c n x1 delta lim where- delta = x2 -# x1+ !delta = x2 -# x1 efdtChar :: Int# -> Int# -> Int# -> String efdtChar x1 x2 lim | delta >=# 0# = go_up_char_list x1 delta lim | otherwise = go_dn_char_list x1 delta lim where- delta = x2 -# x1+ !delta = x2 -# x1 go_up_char_fb :: (Char -> a -> a) -> a -> Int# -> Int# -> Int# -> a go_up_char_fb c n x0 delta lim@@ -453,7 +453,7 @@ {-# INLINE enumFrom #-} enumFrom (I# x) = eftInt x maxInt#- where I# maxInt# = maxInt+ where !(I# maxInt#) = maxInt -- Blarg: technically I guess enumFrom isn't strict! {-# INLINE enumFromTo #-}@@ -528,8 +528,8 @@ efdtIntUp x1 x2 y -- Be careful about overflow! | y <# x2 = if y <# x1 then [] else [I# x1] | otherwise = -- Common case: x1 <= x2 <= y- let delta = x2 -# x1 -- >= 0- y' = y -# delta -- x1 <= y' <= y; hence y' is representable+ let !delta = x2 -# x1 -- >= 0+ !y' = y -# delta -- x1 <= y' <= y; hence y' is representable -- Invariant: x <= y -- Note that: z <= y' => z + delta won't overflow@@ -543,8 +543,8 @@ efdtIntUpFB c n x1 x2 y -- Be careful about overflow! | y <# x2 = if y <# x1 then n else I# x1 `c` n | otherwise = -- Common case: x1 <= x2 <= y- let delta = x2 -# x1 -- >= 0- y' = y -# delta -- x1 <= y' <= y; hence y' is representable+ let !delta = x2 -# x1 -- >= 0+ !y' = y -# delta -- x1 <= y' <= y; hence y' is representable -- Invariant: x <= y -- Note that: z <= y' => z + delta won't overflow@@ -558,8 +558,8 @@ efdtIntDn x1 x2 y -- Be careful about underflow! | y ># x2 = if y ># x1 then [] else [I# x1] | otherwise = -- Common case: x1 >= x2 >= y- let delta = x2 -# x1 -- <= 0- y' = y -# delta -- y <= y' <= x1; hence y' is representable+ let !delta = x2 -# x1 -- <= 0+ !y' = y -# delta -- y <= y' <= x1; hence y' is representable -- Invariant: x >= y -- Note that: z >= y' => z + delta won't underflow@@ -573,8 +573,8 @@ efdtIntDnFB c n x1 x2 y -- Be careful about underflow! | y ># x2 = if y ># x1 then n else I# x1 `c` n | otherwise = -- Common case: x1 >= x2 >= y- let delta = x2 -# x1 -- <= 0- y' = y -# delta -- y <= y' <= x1; hence y' is representable+ let !delta = x2 -# x1 -- <= 0+ !y' = y -# delta -- y <= y' <= x1; hence y' is representable -- Invariant: x >= y -- Note that: z >= y' => z + delta won't underflow
+ GHC/Err.lhs-boot view
@@ -0,0 +1,20 @@+\begin{code}+{-# OPTIONS_GHC -XNoImplicitPrelude #-}+---------------------------------------------------------------------------+-- Ghc.Err.hs-boot+---------------------------------------------------------------------------++module GHC.Err( error ) where++-- The type signature for 'error' is a gross hack.+-- First, we can't give an accurate type for error, because it mentions +-- an open type variable.+-- Second, we can't even say error :: [Char] -> a, because Char is defined+-- in GHC.Base, and that would make Err.lhs-boot mutually recursive +-- with GHC.Base.+-- Fortunately it doesn't matter what type we give here because the +-- compiler will use its wired-in version. But we have+-- to mention 'error' so that it gets exported from this .hi-boot+-- file.+error :: a+\end{code}
GHC/Exception.lhs view
@@ -19,7 +19,7 @@ module GHC.Exception where import Data.Maybe-import {-# SOURCE #-} Data.Typeable+import {-# SOURCE #-} Data.Typeable (Typeable, cast) import GHC.Base import GHC.Show \end{code}
GHC/Exts.hs view
@@ -41,8 +41,11 @@ lazy, inline, -- * Transform comprehensions- Down(..), groupWith, sortWith, the+ Down(..), groupWith, sortWith, the, + -- * Event logging+ traceEvent+ ) where import Prelude@@ -51,10 +54,11 @@ import GHC.Base import GHC.Word import GHC.Int-import GHC.Float+-- import GHC.Float import GHC.Ptr import Data.String import Data.List+import Foreign.C -- XXX This should really be in Data.Tuple, where the definitions are maxTupleSize :: Int@@ -97,3 +101,11 @@ groupByFBCore (x:xs) = c (x:ys) (groupByFBCore zs) where (ys, zs) = span (eq x) xs ++-- -----------------------------------------------------------------------------+-- tracing++traceEvent :: String -> IO ()+traceEvent msg = do+ withCString msg $ \(Ptr p) -> IO $ \s ->+ case traceEvent# p s of s' -> (# s', () #)
GHC/Float.lhs view
@@ -24,6 +24,7 @@ import Data.Maybe +import Data.Bits import GHC.Base import GHC.List import GHC.Enum@@ -199,16 +200,22 @@ {-# INLINE floor #-} {-# INLINE truncate #-} - properFraction x- = case (decodeFloat x) of { (m,n) ->- let b = floatRadix x in- if n >= 0 then- (fromInteger m * fromInteger b ^ n, 0.0)- else- case (quotRem m (b^(negate n))) of { (w,r) ->- (fromInteger w, encodeFloat r n)- }- }+-- We assume that FLT_RADIX is 2 so that we can use more efficient code+#if FLT_RADIX != 2+#error FLT_RADIX must be 2+#endif+ properFraction (F# x#)+ = case decodeFloat_Int# x# of+ (# m#, n# #) ->+ let m = I# m#+ n = I# n#+ in+ if n >= 0+ then (fromIntegral m * (2 ^ n), 0.0)+ else let i = if m >= 0 then m `shiftR` negate n+ else negate (negate m `shiftR` negate n)+ f = m - (i `shiftL` negate n)+ in (fromIntegral i, encodeFloat (fromIntegral f) n) truncate x = case properFraction x of (n,_) -> n@@ -255,8 +262,8 @@ floatDigits _ = FLT_MANT_DIG -- ditto floatRange _ = (FLT_MIN_EXP, FLT_MAX_EXP) -- ditto - decodeFloat (F# f#) = case decodeFloatInteger f# of- (# i, e #) -> (i, I# e)+ decodeFloat (F# f#) = case decodeFloat_Int# f# of+ (# i, e #) -> (smallInteger i, I# e) encodeFloat i (I# e) = F# (encodeFloatInteger i e) @@ -618,7 +625,9 @@ -- Haskell promises that p-1 <= logBase b f < p. (p - 1 + e0) * 3 `div` 10 else- ceiling ((log (fromInteger (f+1)) ++ -- f :: Integer, log :: Float -> Float, + -- ceiling :: Float -> Int+ ceiling ((log (fromInteger (f+1) :: Float) + fromIntegral e * log (fromInteger b)) / log (fromInteger base)) --WAS: fromInt e * log (fromInteger b))@@ -896,20 +905,11 @@ \end{code} \begin{code}-foreign import ccall unsafe "__encodeFloat"- encodeFloat# :: Int# -> ByteArray# -> Int -> Float-foreign import ccall unsafe "__int_encodeFloat"- int_encodeFloat# :: Int# -> Int -> Float-- foreign import ccall unsafe "isFloatNaN" isFloatNaN :: Float -> Int foreign import ccall unsafe "isFloatInfinite" isFloatInfinite :: Float -> Int foreign import ccall unsafe "isFloatDenormalized" isFloatDenormalized :: Float -> Int foreign import ccall unsafe "isFloatNegativeZero" isFloatNegativeZero :: Float -> Int --foreign import ccall unsafe "__encodeDouble"- encodeDouble# :: Int# -> ByteArray# -> Int -> Double foreign import ccall unsafe "isDoubleNaN" isDoubleNaN :: Double -> Int foreign import ccall unsafe "isDoubleInfinite" isDoubleInfinite :: Double -> Int
GHC/ForeignPtr.hs view
@@ -42,7 +42,8 @@ import GHC.Show import GHC.List ( null ) import GHC.Base-import GHC.IOBase+-- import GHC.IO+import GHC.IORef import GHC.STRef ( STRef(..) ) import GHC.Ptr ( Ptr(..), FunPtr(..) ) import GHC.Err@@ -156,8 +157,8 @@ (# s', ForeignPtr (byteArrayContents# (unsafeCoerce# mbarr#)) (MallocPtr mbarr# r) #) }- where (I# size) = sizeOf a- (I# align) = alignment a+ where !(I# size) = sizeOf a+ !(I# align) = alignment a -- | This function is similar to 'mallocForeignPtr', except that the -- size of the memory required is given explicitly as a number of bytes.@@ -191,8 +192,8 @@ (# s', ForeignPtr (byteArrayContents# (unsafeCoerce# mbarr#)) (PlainPtr mbarr#) #) }- where (I# size) = sizeOf a- (I# align) = alignment a+ where !(I# size) = sizeOf a+ !(I# align) = alignment a -- | This function is similar to 'mallocForeignPtrBytes', except that -- the internally an optimised ForeignPtr representation with no
GHC/Handle.hs view
@@ -1,1843 +1,55 @@-{-# OPTIONS_GHC -XNoImplicitPrelude -#include "HsBase.h" #-}-{-# OPTIONS_GHC -fno-warn-unused-matches #-}-{-# OPTIONS_GHC -fno-warn-unused-binds #-}-{-# OPTIONS_HADDOCK hide #-}--#undef DEBUG_DUMP-#undef DEBUG---------------------------------------------------------------------------------- |--- Module : GHC.Handle--- Copyright : (c) The University of Glasgow, 1994-2001--- License : see libraries/base/LICENSE--- --- Maintainer : libraries@haskell.org--- Stability : internal--- Portability : non-portable------ This module defines the basic operations on I\/O \"handles\".------------------------------------------------------------------------------------- #hide-module GHC.Handle (- withHandle, withHandle', withHandle_,- wantWritableHandle, wantReadableHandle, wantSeekableHandle,-- newEmptyBuffer, allocateBuffer, readCharFromBuffer, writeCharIntoBuffer,- flushWriteBufferOnly, flushWriteBuffer, flushReadBuffer,- fillReadBuffer, fillReadBufferWithoutBlocking,- readRawBuffer, readRawBufferPtr,- readRawBufferNoBlock, readRawBufferPtrNoBlock,- writeRawBuffer, writeRawBufferPtr,--#ifndef mingw32_HOST_OS- unlockFile,-#endif-- ioe_closedHandle, ioe_EOF, ioe_notReadable, ioe_notWritable,-- stdin, stdout, stderr,- IOMode(..), openFile, openBinaryFile, fdToHandle_stat, fdToHandle, fdToHandle',- hFileSize, hSetFileSize, hIsEOF, isEOF, hLookAhead, hLookAhead', hSetBuffering, hSetBinaryMode,- hFlush, hDuplicate, hDuplicateTo,-- hClose, hClose_help,-- HandlePosition, HandlePosn(..), hGetPosn, hSetPosn,- SeekMode(..), hSeek, hTell,-- hIsOpen, hIsClosed, hIsReadable, hIsWritable, hGetBuffering, hIsSeekable,- hSetEcho, hGetEcho, hIsTerminalDevice,-- hShow,--#ifdef DEBUG_DUMP- puts,-#endif-- ) where--import Control.Monad-import Data.Maybe-import Foreign-import Foreign.C-import System.IO.Error-import System.Posix.Internals-import System.Posix.Types--import GHC.Real--import GHC.Arr-import GHC.Base-import GHC.Read ( Read )-import GHC.List-import GHC.IOBase-import GHC.Exception-import GHC.Enum-import GHC.Num ( Integer, Num(..) )-import GHC.Show-#if defined(DEBUG_DUMP)-import GHC.Pack-#endif--import GHC.Conc---- -------------------------------------------------------------------------------- TODO:---- hWaitForInput blocks (should use a timeout)---- unbuffered hGetLine is a bit dodgy---- hSetBuffering: can't change buffering on a stream, --- when the read buffer is non-empty? (no way to flush the buffer)---- ------------------------------------------------------------------------------ Are files opened by default in text or binary mode, if the user doesn't--- specify?--dEFAULT_OPEN_IN_BINARY_MODE :: Bool-dEFAULT_OPEN_IN_BINARY_MODE = False---- ------------------------------------------------------------------------------ Creating a new handle--newFileHandle :: FilePath -> (MVar Handle__ -> IO ()) -> Handle__ -> IO Handle-newFileHandle filepath finalizer hc = do- m <- newMVar hc- addMVarFinalizer m (finalizer m)- return (FileHandle filepath m)---- ------------------------------------------------------------------------------ Working with Handles--{--In the concurrent world, handles are locked during use. This is done-by wrapping an MVar around the handle which acts as a mutex over-operations on the handle.--To avoid races, we use the following bracketing operations. The idea-is to obtain the lock, do some operation and replace the lock again,-whether the operation succeeded or failed. We also want to handle the-case where the thread receives an exception while processing the IO-operation: in these cases we also want to relinquish the lock.--There are three versions of @withHandle@: corresponding to the three-possible combinations of:-- - the operation may side-effect the handle- - the operation may return a result--If the operation generates an error or an exception is raised, the-original handle is always replaced [ this is the case at the moment,-but we might want to revisit this in the future --SDM ].--}--{-# INLINE withHandle #-}-withHandle :: String -> Handle -> (Handle__ -> IO (Handle__,a)) -> IO a-withHandle fun h@(FileHandle _ m) act = withHandle' fun h m act-withHandle fun h@(DuplexHandle _ m _) act = withHandle' fun h m act--withHandle' :: String -> Handle -> MVar Handle__- -> (Handle__ -> IO (Handle__,a)) -> IO a-withHandle' fun h m act =- block $ do- h_ <- takeMVar m- checkBufferInvariants h_- (h',v) <- (act h_ `catchAny` \err -> putMVar m h_ >> throw err)- `catchException` \ex -> ioError (augmentIOError ex fun h)- checkBufferInvariants h'- putMVar m h'- return v--{-# INLINE withHandle_ #-}-withHandle_ :: String -> Handle -> (Handle__ -> IO a) -> IO a-withHandle_ fun h@(FileHandle _ m) act = withHandle_' fun h m act-withHandle_ fun h@(DuplexHandle _ m _) act = withHandle_' fun h m act--withHandle_' :: String -> Handle -> MVar Handle__ -> (Handle__ -> IO a) -> IO a-withHandle_' fun h m act =- block $ do- h_ <- takeMVar m- checkBufferInvariants h_- v <- (act h_ `catchAny` \err -> putMVar m h_ >> throw err)- `catchException` \ex -> ioError (augmentIOError ex fun h)- checkBufferInvariants h_- putMVar m h_- return v--withAllHandles__ :: String -> Handle -> (Handle__ -> IO Handle__) -> IO ()-withAllHandles__ fun h@(FileHandle _ m) act = withHandle__' fun h m act-withAllHandles__ fun h@(DuplexHandle _ r w) act = do- withHandle__' fun h r act- withHandle__' fun h w act--withHandle__' :: String -> Handle -> MVar Handle__ -> (Handle__ -> IO Handle__)- -> IO ()-withHandle__' fun h m act =- block $ do- h_ <- takeMVar m- checkBufferInvariants h_- h' <- (act h_ `catchAny` \err -> putMVar m h_ >> throw err)- `catchException` \ex -> ioError (augmentIOError ex fun h)- checkBufferInvariants h'- putMVar m h'- return ()--augmentIOError :: IOException -> String -> Handle -> IOException-augmentIOError (IOError _ iot _ str fp) fun h- = IOError (Just h) iot fun str filepath- where filepath- | Just _ <- fp = fp- | otherwise = case h of- FileHandle path _ -> Just path- DuplexHandle path _ _ -> Just path---- ------------------------------------------------------------------------------ Wrapper for write operations.--wantWritableHandle :: String -> Handle -> (Handle__ -> IO a) -> IO a-wantWritableHandle fun h@(FileHandle _ m) act- = wantWritableHandle' fun h m act-wantWritableHandle fun h@(DuplexHandle _ _ m) act- = wantWritableHandle' fun h m act- -- ToDo: in the Duplex case, we don't need to checkWritableHandle--wantWritableHandle'- :: String -> Handle -> MVar Handle__- -> (Handle__ -> IO a) -> IO a-wantWritableHandle' fun h m act- = withHandle_' fun h m (checkWritableHandle act)--checkWritableHandle :: (Handle__ -> IO a) -> Handle__ -> IO a-checkWritableHandle act handle_- = case haType handle_ of- ClosedHandle -> ioe_closedHandle- SemiClosedHandle -> ioe_closedHandle- ReadHandle -> ioe_notWritable- ReadWriteHandle -> do- let ref = haBuffer handle_- buf <- readIORef ref- new_buf <-- if not (bufferIsWritable buf)- then do b <- flushReadBuffer (haFD handle_) buf- return b{ bufState=WriteBuffer }- else return buf- writeIORef ref new_buf- act handle_- _other -> act handle_---- ------------------------------------------------------------------------------ Wrapper for read operations.--wantReadableHandle :: String -> Handle -> (Handle__ -> IO a) -> IO a-wantReadableHandle fun h@(FileHandle _ m) act- = wantReadableHandle' fun h m act-wantReadableHandle fun h@(DuplexHandle _ m _) act- = wantReadableHandle' fun h m act- -- ToDo: in the Duplex case, we don't need to checkReadableHandle--wantReadableHandle'- :: String -> Handle -> MVar Handle__- -> (Handle__ -> IO a) -> IO a-wantReadableHandle' fun h m act- = withHandle_' fun h m (checkReadableHandle act)--checkReadableHandle :: (Handle__ -> IO a) -> Handle__ -> IO a-checkReadableHandle act handle_ =- case haType handle_ of- ClosedHandle -> ioe_closedHandle- SemiClosedHandle -> ioe_closedHandle- AppendHandle -> ioe_notReadable- WriteHandle -> ioe_notReadable- ReadWriteHandle -> do- let ref = haBuffer handle_- buf <- readIORef ref- when (bufferIsWritable buf) $ do- new_buf <- flushWriteBuffer (haFD handle_) (haIsStream handle_) buf- writeIORef ref new_buf{ bufState=ReadBuffer }- act handle_- _other -> act handle_---- ------------------------------------------------------------------------------ Wrapper for seek operations.--wantSeekableHandle :: String -> Handle -> (Handle__ -> IO a) -> IO a-wantSeekableHandle fun h@(DuplexHandle _ _ _) _act =- ioException (IOError (Just h) IllegalOperation fun- "handle is not seekable" Nothing)-wantSeekableHandle fun h@(FileHandle _ m) act =- withHandle_' fun h m (checkSeekableHandle act)--checkSeekableHandle :: (Handle__ -> IO a) -> Handle__ -> IO a-checkSeekableHandle act handle_ =- case haType handle_ of- ClosedHandle -> ioe_closedHandle- SemiClosedHandle -> ioe_closedHandle- AppendHandle -> ioe_notSeekable- _ | haIsBin handle_ || tEXT_MODE_SEEK_ALLOWED -> act handle_- | otherwise -> ioe_notSeekable_notBin---- -------------------------------------------------------------------------------- Handy IOErrors--ioe_closedHandle, ioe_EOF,- ioe_notReadable, ioe_notWritable,- ioe_notSeekable, ioe_notSeekable_notBin :: IO a--ioe_closedHandle = ioException- (IOError Nothing IllegalOperation ""- "handle is closed" Nothing)-ioe_EOF = ioException- (IOError Nothing EOF "" "" Nothing)-ioe_notReadable = ioException- (IOError Nothing IllegalOperation ""- "handle is not open for reading" Nothing)-ioe_notWritable = ioException- (IOError Nothing IllegalOperation ""- "handle is not open for writing" Nothing)-ioe_notSeekable = ioException- (IOError Nothing IllegalOperation ""- "handle is not seekable" Nothing)-ioe_notSeekable_notBin = ioException- (IOError Nothing IllegalOperation ""- "seek operations on text-mode handles are not allowed on this platform"- Nothing)--ioe_finalizedHandle :: FilePath -> Handle__-ioe_finalizedHandle fp = throw- (IOError Nothing IllegalOperation ""- "handle is finalized" (Just fp))--ioe_bufsiz :: Int -> IO a-ioe_bufsiz n = ioException- (IOError Nothing InvalidArgument "hSetBuffering"- ("illegal buffer size " ++ showsPrec 9 n []) Nothing)- -- 9 => should be parens'ified.---- -------------------------------------------------------------------------------- Handle Finalizers---- For a duplex handle, we arrange that the read side points to the write side--- (and hence keeps it alive if the read side is alive). This is done by--- having the haOtherSide field of the read side point to the read side.--- The finalizer is then placed on the write side, and the handle only gets--- finalized once, when both sides are no longer required.---- NOTE about finalized handles: It's possible that a handle can be--- finalized and then we try to use it later, for example if the--- handle is referenced from another finalizer, or from a thread that--- has become unreferenced and then resurrected (arguably in the--- latter case we shouldn't finalize the Handle...). Anyway,--- we try to emit a helpful message which is better than nothing.--stdHandleFinalizer :: FilePath -> MVar Handle__ -> IO ()-stdHandleFinalizer fp m = do- h_ <- takeMVar m- flushWriteBufferOnly h_- putMVar m (ioe_finalizedHandle fp)--handleFinalizer :: FilePath -> MVar Handle__ -> IO ()-handleFinalizer fp m = do- handle_ <- takeMVar m- case haType handle_ of- ClosedHandle -> return ()- _ -> do flushWriteBufferOnly handle_ `catchAny` \_ -> return ()- -- ignore errors and async exceptions, and close the- -- descriptor anyway...- hClose_handle_ handle_- return ()- putMVar m (ioe_finalizedHandle fp)---- ------------------------------------------------------------------------------ Grimy buffer operations--checkBufferInvariants :: Handle__ -> IO ()-#ifdef DEBUG-checkBufferInvariants h_ = do- let ref = haBuffer h_- Buffer{ bufWPtr=w, bufRPtr=r, bufSize=size, bufState=state } <- readIORef ref- if not (- size > 0- && r <= w- && w <= size- && ( r /= w || (r == 0 && w == 0) )- && ( state /= WriteBuffer || r == 0 )- && ( state /= WriteBuffer || w < size ) -- write buffer is never full- )- then error "buffer invariant violation"- else return ()-#else-checkBufferInvariants _ = return ()-#endif--newEmptyBuffer :: RawBuffer -> BufferState -> Int -> Buffer-newEmptyBuffer b state size- = Buffer{ bufBuf=b, bufRPtr=0, bufWPtr=0, bufSize=size, bufState=state }--allocateBuffer :: Int -> BufferState -> IO Buffer-allocateBuffer sz@(I# size) state = IO $ \s -> - -- We sometimes need to pass the address of this buffer to- -- a "safe" foreign call, hence it must be immovable.- case newPinnedByteArray# size s of { (# s', b #) ->- (# s', newEmptyBuffer b state sz #) }--writeCharIntoBuffer :: RawBuffer -> Int -> Char -> IO Int-writeCharIntoBuffer slab (I# off) (C# c)- = IO $ \s -> case writeCharArray# slab off c s of - s' -> (# s', I# (off +# 1#) #)--readCharFromBuffer :: RawBuffer -> Int -> IO (Char, Int)-readCharFromBuffer slab (I# off)- = IO $ \s -> case readCharArray# slab off s of - (# s', c #) -> (# s', (C# c, I# (off +# 1#)) #)--getBuffer :: FD -> BufferState -> IO (IORef Buffer, BufferMode)-getBuffer fd state = do- buffer <- allocateBuffer dEFAULT_BUFFER_SIZE state- ioref <- newIORef buffer- is_tty <- fdIsTTY fd-- let buffer_mode - | is_tty = LineBuffering - | otherwise = BlockBuffering Nothing-- return (ioref, buffer_mode)--mkUnBuffer :: IO (IORef Buffer)-mkUnBuffer = do- buffer <- allocateBuffer 1 ReadBuffer- newIORef buffer---- flushWriteBufferOnly flushes the buffer iff it contains pending write data.-flushWriteBufferOnly :: Handle__ -> IO ()-flushWriteBufferOnly h_ = do- let fd = haFD h_- ref = haBuffer h_- buf <- readIORef ref- new_buf <- if bufferIsWritable buf - then flushWriteBuffer fd (haIsStream h_) buf - else return buf- writeIORef ref new_buf---- flushBuffer syncs the file with the buffer, including moving the--- file pointer backwards in the case of a read buffer.-flushBuffer :: Handle__ -> IO ()-flushBuffer h_ = do- let ref = haBuffer h_- buf <- readIORef ref-- flushed_buf <-- case bufState buf of- ReadBuffer -> flushReadBuffer (haFD h_) buf- WriteBuffer -> flushWriteBuffer (haFD h_) (haIsStream h_) buf-- writeIORef ref flushed_buf---- When flushing a read buffer, we seek backwards by the number of--- characters in the buffer. The file descriptor must therefore be--- seekable: attempting to flush the read buffer on an unseekable--- handle is not allowed.--flushReadBuffer :: FD -> Buffer -> IO Buffer-flushReadBuffer fd buf- | bufferEmpty buf = return buf- | otherwise = do- let off = negate (bufWPtr buf - bufRPtr buf)-# ifdef DEBUG_DUMP- puts ("flushReadBuffer: new file offset = " ++ show off ++ "\n")-# endif- throwErrnoIfMinus1Retry "flushReadBuffer"- (c_lseek fd (fromIntegral off) sEEK_CUR)- return buf{ bufWPtr=0, bufRPtr=0 }--flushWriteBuffer :: FD -> Bool -> Buffer -> IO Buffer-flushWriteBuffer fd is_stream buf@Buffer{ bufBuf=b, bufRPtr=r, bufWPtr=w } =- seq fd $ do -- strictness hack- let bytes = w - r-#ifdef DEBUG_DUMP- puts ("flushWriteBuffer, fd=" ++ show fd ++ ", bytes=" ++ show bytes ++ "\n")-#endif- if bytes == 0- then return (buf{ bufRPtr=0, bufWPtr=0 })- else do- res <- writeRawBuffer "flushWriteBuffer" fd is_stream b - (fromIntegral r) (fromIntegral bytes)- let res' = fromIntegral res- if res' < bytes - then flushWriteBuffer fd is_stream (buf{ bufRPtr = r + res' })- else return buf{ bufRPtr=0, bufWPtr=0 }--fillReadBuffer :: FD -> Bool -> Bool -> Buffer -> IO Buffer-fillReadBuffer fd is_line is_stream- buf@Buffer{ bufBuf=b, bufRPtr=r, bufWPtr=w, bufSize=size } =- -- buffer better be empty:- assert (r == 0 && w == 0) $ do- fillReadBufferLoop fd is_line is_stream buf b w size---- For a line buffer, we just get the first chunk of data to arrive,--- and don't wait for the whole buffer to be full (but we *do* wait--- until some data arrives). This isn't really line buffering, but it--- appears to be what GHC has done for a long time, and I suspect it--- is more useful than line buffering in most cases.--fillReadBufferLoop :: FD -> Bool -> Bool -> Buffer -> RawBuffer -> Int -> Int- -> IO Buffer-fillReadBufferLoop fd is_line is_stream buf b w size = do- let bytes = size - w- if bytes == 0 -- buffer full?- then return buf{ bufRPtr=0, bufWPtr=w }- else do-#ifdef DEBUG_DUMP- puts ("fillReadBufferLoop: bytes = " ++ show bytes ++ "\n")-#endif- res <- readRawBuffer "fillReadBuffer" fd is_stream b- (fromIntegral w) (fromIntegral bytes)- let res' = fromIntegral res-#ifdef DEBUG_DUMP- puts ("fillReadBufferLoop: res' = " ++ show res' ++ "\n")-#endif- if res' == 0- then if w == 0- then ioe_EOF- else return buf{ bufRPtr=0, bufWPtr=w }- else if res' < bytes && not is_line- then fillReadBufferLoop fd is_line is_stream buf b (w+res') size- else return buf{ bufRPtr=0, bufWPtr=w+res' }- --fillReadBufferWithoutBlocking :: FD -> Bool -> Buffer -> IO Buffer-fillReadBufferWithoutBlocking fd is_stream- buf@Buffer{ bufBuf=b, bufRPtr=r, bufWPtr=w, bufSize=size } =- -- buffer better be empty:- assert (r == 0 && w == 0) $ do-#ifdef DEBUG_DUMP- puts ("fillReadBufferLoopNoBlock: bytes = " ++ show size ++ "\n")-#endif- res <- readRawBufferNoBlock "fillReadBuffer" fd is_stream b- 0 (fromIntegral size)- let res' = fromIntegral res-#ifdef DEBUG_DUMP- puts ("fillReadBufferLoopNoBlock: res' = " ++ show res' ++ "\n")-#endif- return buf{ bufRPtr=0, bufWPtr=res' }- --- Low level routines for reading/writing to (raw)buffers:--#ifndef mingw32_HOST_OS--{--NOTE [nonblock]:--Unix has broken semantics when it comes to non-blocking I/O: you can-set the O_NONBLOCK flag on an FD, but it applies to the all other FDs-attached to the same underlying file, pipe or TTY; there's no way to-have private non-blocking behaviour for an FD. See bug #724.--We fix this by only setting O_NONBLOCK on FDs that we create; FDs that-come from external sources or are exposed externally are left in-blocking mode. This solution has some problems though. We can't-completely simulate a non-blocking read without O_NONBLOCK: several-cases are wrong here. The cases that are wrong:-- * reading/writing to a blocking FD in non-threaded mode.- In threaded mode, we just make a safe call to read(). - In non-threaded mode we call select() before attempting to read,- but that leaves a small race window where the data can be read- from the file descriptor before we issue our blocking read().- * readRawBufferNoBlock for a blocking FD--NOTE [2363]:--In the threaded RTS we could just make safe calls to read()/write()-for file descriptors in blocking mode without worrying about blocking-other threads, but the problem with this is that the thread will be-uninterruptible while it is blocked in the foreign call. See #2363.-So now we always call fdReady() before reading, and if fdReady-indicates that there's no data, we call threadWaitRead.---}--readRawBuffer :: String -> FD -> Bool -> RawBuffer -> Int -> CInt -> IO CInt-readRawBuffer loc fd is_nonblock buf off len- | is_nonblock = unsafe_read -- unsafe is ok, it can't block- | otherwise = do r <- throwErrnoIfMinus1 loc - (unsafe_fdReady (fromIntegral fd) 0 0 0)- if r /= 0- then read- else do threadWaitRead (fromIntegral fd); read- where- do_read call = throwErrnoIfMinus1RetryMayBlock loc call - (threadWaitRead (fromIntegral fd))- read = if threaded then safe_read else unsafe_read- unsafe_read = do_read (read_rawBuffer fd buf off len)- safe_read = do_read (safe_read_rawBuffer fd buf off len)--readRawBufferPtr :: String -> FD -> Bool -> Ptr CChar -> Int -> CInt -> IO CInt-readRawBufferPtr loc fd is_nonblock buf off len- | is_nonblock = unsafe_read -- unsafe is ok, it can't block- | otherwise = do r <- throwErrnoIfMinus1 loc - (unsafe_fdReady (fromIntegral fd) 0 0 0)- if r /= 0 - then read- else do threadWaitRead (fromIntegral fd); read- where- do_read call = throwErrnoIfMinus1RetryMayBlock loc call - (threadWaitRead (fromIntegral fd))- read = if threaded then safe_read else unsafe_read- unsafe_read = do_read (read_off fd buf off len)- safe_read = do_read (safe_read_off fd buf off len)--readRawBufferNoBlock :: String -> FD -> Bool -> RawBuffer -> Int -> CInt -> IO CInt-readRawBufferNoBlock loc fd is_nonblock buf off len- | is_nonblock = unsafe_read -- unsafe is ok, it can't block- | otherwise = do r <- unsafe_fdReady (fromIntegral fd) 0 0 0- if r /= 0 then safe_read- else return 0- -- XXX see note [nonblock]- where- do_read call = throwErrnoIfMinus1RetryOnBlock loc call (return 0)- unsafe_read = do_read (read_rawBuffer fd buf off len)- safe_read = do_read (safe_read_rawBuffer fd buf off len)--readRawBufferPtrNoBlock :: String -> FD -> Bool -> Ptr CChar -> Int -> CInt -> IO CInt-readRawBufferPtrNoBlock loc fd is_nonblock buf off len- | is_nonblock = unsafe_read -- unsafe is ok, it can't block- | otherwise = do r <- unsafe_fdReady (fromIntegral fd) 0 0 0- if r /= 0 then safe_read- else return 0- -- XXX see note [nonblock]- where- do_read call = throwErrnoIfMinus1RetryOnBlock loc call (return 0)- unsafe_read = do_read (read_off fd buf off len)- safe_read = do_read (safe_read_off fd buf off len)--writeRawBuffer :: String -> FD -> Bool -> RawBuffer -> Int -> CInt -> IO CInt-writeRawBuffer loc fd is_nonblock buf off len- | is_nonblock = unsafe_write -- unsafe is ok, it can't block- | otherwise = do r <- unsafe_fdReady (fromIntegral fd) 1 0 0- if r /= 0 - then write- else do threadWaitWrite (fromIntegral fd); write- where - do_write call = throwErrnoIfMinus1RetryMayBlock loc call- (threadWaitWrite (fromIntegral fd)) - write = if threaded then safe_write else unsafe_write- unsafe_write = do_write (write_rawBuffer fd buf off len)- safe_write = do_write (safe_write_rawBuffer (fromIntegral fd) buf off len)--writeRawBufferPtr :: String -> FD -> Bool -> Ptr CChar -> Int -> CInt -> IO CInt-writeRawBufferPtr loc fd is_nonblock buf off len- | is_nonblock = unsafe_write -- unsafe is ok, it can't block- | otherwise = do r <- unsafe_fdReady (fromIntegral fd) 1 0 0- if r /= 0 - then write- else do threadWaitWrite (fromIntegral fd); write- where- do_write call = throwErrnoIfMinus1RetryMayBlock loc call- (threadWaitWrite (fromIntegral fd)) - write = if threaded then safe_write else unsafe_write- unsafe_write = do_write (write_off fd buf off len)- safe_write = do_write (safe_write_off (fromIntegral fd) buf off len)--foreign import ccall unsafe "__hscore_PrelHandle_read"- read_rawBuffer :: CInt -> RawBuffer -> Int -> CInt -> IO CInt--foreign import ccall unsafe "__hscore_PrelHandle_read"- read_off :: CInt -> Ptr CChar -> Int -> CInt -> IO CInt--foreign import ccall unsafe "__hscore_PrelHandle_write"- write_rawBuffer :: CInt -> RawBuffer -> Int -> CInt -> IO CInt--foreign import ccall unsafe "__hscore_PrelHandle_write"- write_off :: CInt -> Ptr CChar -> Int -> CInt -> IO CInt--foreign import ccall unsafe "fdReady"- unsafe_fdReady :: CInt -> CInt -> CInt -> CInt -> IO CInt--#else /* mingw32_HOST_OS.... */--readRawBuffer :: String -> FD -> Bool -> RawBuffer -> Int -> CInt -> IO CInt-readRawBuffer loc fd is_stream buf off len- | threaded = blockingReadRawBuffer loc fd is_stream buf off len- | otherwise = asyncReadRawBuffer loc fd is_stream buf off len--readRawBufferPtr :: String -> FD -> Bool -> Ptr CChar -> Int -> CInt -> IO CInt-readRawBufferPtr loc fd is_stream buf off len- | threaded = blockingReadRawBufferPtr loc fd is_stream buf off len- | otherwise = asyncReadRawBufferPtr loc fd is_stream buf off len--writeRawBuffer :: String -> FD -> Bool -> RawBuffer -> Int -> CInt -> IO CInt-writeRawBuffer loc fd is_stream buf off len- | threaded = blockingWriteRawBuffer loc fd is_stream buf off len- | otherwise = asyncWriteRawBuffer loc fd is_stream buf off len--writeRawBufferPtr :: String -> FD -> Bool -> Ptr CChar -> Int -> CInt -> IO CInt-writeRawBufferPtr loc fd is_stream buf off len- | threaded = blockingWriteRawBufferPtr loc fd is_stream buf off len- | otherwise = asyncWriteRawBufferPtr loc fd is_stream buf off len---- ToDo: we don't have a non-blocking primitve read on Win32-readRawBufferNoBlock :: String -> FD -> Bool -> RawBuffer -> Int -> CInt -> IO CInt-readRawBufferNoBlock = readRawBuffer--readRawBufferPtrNoBlock :: String -> FD -> Bool -> Ptr CChar -> Int -> CInt -> IO CInt-readRawBufferPtrNoBlock = readRawBufferPtr--- Async versions of the read/write primitives, for the non-threaded RTS--asyncReadRawBuffer :: String -> FD -> Bool -> RawBuffer -> Int -> CInt- -> IO CInt-asyncReadRawBuffer loc fd is_stream buf off len = do- (l, rc) <- asyncReadBA (fromIntegral fd) (if is_stream then 1 else 0) - (fromIntegral len) off buf- if l == (-1)- then - ioError (errnoToIOError loc (Errno (fromIntegral rc)) Nothing Nothing)- else return (fromIntegral l)--asyncReadRawBufferPtr :: String -> FD -> Bool -> Ptr CChar -> Int -> CInt- -> IO CInt-asyncReadRawBufferPtr loc fd is_stream buf off len = do- (l, rc) <- asyncRead (fromIntegral fd) (if is_stream then 1 else 0) - (fromIntegral len) (buf `plusPtr` off)- if l == (-1)- then - ioError (errnoToIOError loc (Errno (fromIntegral rc)) Nothing Nothing)- else return (fromIntegral l)--asyncWriteRawBuffer :: String -> FD -> Bool -> RawBuffer -> Int -> CInt- -> IO CInt-asyncWriteRawBuffer loc fd is_stream buf off len = do- (l, rc) <- asyncWriteBA (fromIntegral fd) (if is_stream then 1 else 0) - (fromIntegral len) off buf- if l == (-1)- then - ioError (errnoToIOError loc (Errno (fromIntegral rc)) Nothing Nothing)- else return (fromIntegral l)--asyncWriteRawBufferPtr :: String -> FD -> Bool -> CString -> Int -> CInt- -> IO CInt-asyncWriteRawBufferPtr loc fd is_stream buf off len = do- (l, rc) <- asyncWrite (fromIntegral fd) (if is_stream then 1 else 0) - (fromIntegral len) (buf `plusPtr` off)- if l == (-1)- then - ioError (errnoToIOError loc (Errno (fromIntegral rc)) Nothing Nothing)- else return (fromIntegral l)---- Blocking versions of the read/write primitives, for the threaded RTS--blockingReadRawBuffer :: String -> CInt -> Bool -> RawBuffer -> Int -> CInt- -> IO CInt-blockingReadRawBuffer loc fd True buf off len = - throwErrnoIfMinus1Retry loc $- safe_recv_rawBuffer fd buf off len-blockingReadRawBuffer loc fd False buf off len = - throwErrnoIfMinus1Retry loc $- safe_read_rawBuffer fd buf off len--blockingReadRawBufferPtr :: String -> CInt -> Bool -> CString -> Int -> CInt- -> IO CInt-blockingReadRawBufferPtr loc fd True buf off len = - throwErrnoIfMinus1Retry loc $- safe_recv_off fd buf off len-blockingReadRawBufferPtr loc fd False buf off len = - throwErrnoIfMinus1Retry loc $- safe_read_off fd buf off len--blockingWriteRawBuffer :: String -> CInt -> Bool -> RawBuffer -> Int -> CInt- -> IO CInt-blockingWriteRawBuffer loc fd True buf off len = - throwErrnoIfMinus1Retry loc $- safe_send_rawBuffer fd buf off len-blockingWriteRawBuffer loc fd False buf off len = - throwErrnoIfMinus1Retry loc $- safe_write_rawBuffer fd buf off len--blockingWriteRawBufferPtr :: String -> CInt -> Bool -> CString -> Int -> CInt- -> IO CInt-blockingWriteRawBufferPtr loc fd True buf off len = - throwErrnoIfMinus1Retry loc $- safe_send_off fd buf off len-blockingWriteRawBufferPtr loc fd False buf off len = - throwErrnoIfMinus1Retry loc $- safe_write_off fd buf off len---- NOTE: "safe" versions of the read/write calls for use by the threaded RTS.--- These calls may block, but that's ok.--foreign import ccall safe "__hscore_PrelHandle_recv"- safe_recv_rawBuffer :: CInt -> RawBuffer -> Int -> CInt -> IO CInt--foreign import ccall safe "__hscore_PrelHandle_recv"- safe_recv_off :: CInt -> Ptr CChar -> Int -> CInt -> IO CInt--foreign import ccall safe "__hscore_PrelHandle_send"- safe_send_rawBuffer :: CInt -> RawBuffer -> Int -> CInt -> IO CInt--foreign import ccall safe "__hscore_PrelHandle_send"- safe_send_off :: CInt -> Ptr CChar -> Int -> CInt -> IO CInt--#endif--foreign import ccall "rtsSupportsBoundThreads" threaded :: Bool--foreign import ccall safe "__hscore_PrelHandle_read"- safe_read_rawBuffer :: FD -> RawBuffer -> Int -> CInt -> IO CInt--foreign import ccall safe "__hscore_PrelHandle_read"- safe_read_off :: FD -> Ptr CChar -> Int -> CInt -> IO CInt--foreign import ccall safe "__hscore_PrelHandle_write"- safe_write_rawBuffer :: CInt -> RawBuffer -> Int -> CInt -> IO CInt--foreign import ccall safe "__hscore_PrelHandle_write"- safe_write_off :: CInt -> Ptr CChar -> Int -> CInt -> IO CInt---- ------------------------------------------------------------------------------ Standard Handles---- Three handles are allocated during program initialisation. The first--- two manage input or output from the Haskell program's standard input--- or output channel respectively. The third manages output to the--- standard error channel. These handles are initially open.--fd_stdin, fd_stdout, fd_stderr :: FD-fd_stdin = 0-fd_stdout = 1-fd_stderr = 2---- | A handle managing input from the Haskell program's standard input channel.-stdin :: Handle-stdin = unsafePerformIO $ do- -- ToDo: acquire lock- -- We don't set non-blocking mode on standard handles, because it may- -- confuse other applications attached to the same TTY/pipe- -- see Note [nonblock]- (buf, bmode) <- getBuffer fd_stdin ReadBuffer- mkStdHandle fd_stdin "<stdin>" ReadHandle buf bmode---- | A handle managing output to the Haskell program's standard output channel.-stdout :: Handle-stdout = unsafePerformIO $ do- -- ToDo: acquire lock- -- We don't set non-blocking mode on standard handles, because it may- -- confuse other applications attached to the same TTY/pipe- -- see Note [nonblock]- (buf, bmode) <- getBuffer fd_stdout WriteBuffer- mkStdHandle fd_stdout "<stdout>" WriteHandle buf bmode---- | A handle managing output to the Haskell program's standard error channel.-stderr :: Handle-stderr = unsafePerformIO $ do- -- ToDo: acquire lock- -- We don't set non-blocking mode on standard handles, because it may- -- confuse other applications attached to the same TTY/pipe- -- see Note [nonblock]- buf <- mkUnBuffer- mkStdHandle fd_stderr "<stderr>" WriteHandle buf NoBuffering---- ------------------------------------------------------------------------------ Opening and Closing Files--addFilePathToIOError :: String -> FilePath -> IOException -> IOException-addFilePathToIOError fun fp (IOError h iot _ str _)- = IOError h iot fun str (Just fp)---- | Computation 'openFile' @file mode@ allocates and returns a new, open--- handle to manage the file @file@. It manages input if @mode@--- is 'ReadMode', output if @mode@ is 'WriteMode' or 'AppendMode',--- and both input and output if mode is 'ReadWriteMode'.------ If the file does not exist and it is opened for output, it should be--- created as a new file. If @mode@ is 'WriteMode' and the file--- already exists, then it should be truncated to zero length.--- Some operating systems delete empty files, so there is no guarantee--- that the file will exist following an 'openFile' with @mode@--- 'WriteMode' unless it is subsequently written to successfully.--- The handle is positioned at the end of the file if @mode@ is--- 'AppendMode', and otherwise at the beginning (in which case its--- internal position is 0).--- The initial buffer mode is implementation-dependent.------ This operation may fail with:------ * 'isAlreadyInUseError' if the file is already open and cannot be reopened;------ * 'isDoesNotExistError' if the file does not exist; or------ * 'isPermissionError' if the user does not have permission to open the file.------ Note: if you will be working with files containing binary data, you'll want to--- be using 'openBinaryFile'.-openFile :: FilePath -> IOMode -> IO Handle-openFile fp im = - catch - (openFile' fp im dEFAULT_OPEN_IN_BINARY_MODE)- (\e -> ioError (addFilePathToIOError "openFile" fp e))---- | Like 'openFile', but open the file in binary mode.--- On Windows, reading a file in text mode (which is the default)--- will translate CRLF to LF, and writing will translate LF to CRLF.--- This is usually what you want with text files. With binary files--- this is undesirable; also, as usual under Microsoft operating systems,--- text mode treats control-Z as EOF. Binary mode turns off all special--- treatment of end-of-line and end-of-file characters.--- (See also 'hSetBinaryMode'.)--openBinaryFile :: FilePath -> IOMode -> IO Handle-openBinaryFile fp m =- catch- (openFile' fp m True)- (\e -> ioError (addFilePathToIOError "openBinaryFile" fp e))--openFile' :: String -> IOMode -> Bool -> IO Handle-openFile' filepath mode binary =- withCString filepath $ \ f ->-- let - oflags1 = case mode of- ReadMode -> read_flags-#ifdef mingw32_HOST_OS- WriteMode -> write_flags .|. o_TRUNC-#else- WriteMode -> write_flags-#endif- ReadWriteMode -> rw_flags- AppendMode -> append_flags-- binary_flags- | binary = o_BINARY- | otherwise = 0-- oflags = oflags1 .|. binary_flags- in do-- -- the old implementation had a complicated series of three opens,- -- which is perhaps because we have to be careful not to open- -- directories. However, the man pages I've read say that open()- -- always returns EISDIR if the file is a directory and was opened- -- for writing, so I think we're ok with a single open() here...- fd <- throwErrnoIfMinus1Retry "openFile"- (c_open f (fromIntegral oflags) 0o666)-- stat@(fd_type,_,_) <- fdStat fd-- h <- fdToHandle_stat fd (Just stat) - False -- set_non_blocking- True -- is_non_blocking- False -- is_socket- filepath mode binary- `catchAny` \e -> do c_close fd; throw e- -- NB. don't forget to close the FD if fdToHandle' fails, otherwise- -- this FD leaks.- -- ASSERT: if we just created the file, then fdToHandle' won't fail- -- (so we don't need to worry about removing the newly created file- -- in the event of an error).--#ifndef mingw32_HOST_OS- -- we want to truncate() if this is an open in WriteMode, but only- -- if the target is a RegularFile. ftruncate() fails on special files- -- like /dev/null.- if mode == WriteMode && fd_type == RegularFile- then throwErrnoIf (/=0) "openFile" - (c_ftruncate fd 0)- else return 0-#endif- return h---std_flags, output_flags, read_flags, write_flags, rw_flags,- append_flags :: CInt-std_flags = o_NONBLOCK .|. o_NOCTTY-output_flags = std_flags .|. o_CREAT-read_flags = std_flags .|. o_RDONLY -write_flags = output_flags .|. o_WRONLY-rw_flags = output_flags .|. o_RDWR-append_flags = write_flags .|. o_APPEND---- ------------------------------------------------------------------------------ fdToHandle--fdToHandle_stat :: FD- -> Maybe (FDType, CDev, CIno)- -> Bool -- set_non_blocking- -> Bool -- is_non_blocking- -> Bool -- is_socket- -> FilePath- -> IOMode- -> Bool- -> IO Handle--fdToHandle_stat fd mb_stat set_non_blocking is_non_blocking is_socket - filepath mode binary = do--#ifdef mingw32_HOST_OS- -- On Windows, the is_stream flag indicates that the Handle is a socket- let is_stream = is_socket-#else- when set_non_blocking $ setNonBlockingFD fd- -- turn on non-blocking mode-- -- On Unix, the is_stream flag indicates that the FD is in non-blocking mode- let is_stream = is_non_blocking || set_non_blocking-#endif-- let (ha_type, write) =- case mode of- ReadMode -> ( ReadHandle, False )- WriteMode -> ( WriteHandle, True )- ReadWriteMode -> ( ReadWriteHandle, True )- AppendMode -> ( AppendHandle, True )-- -- open() won't tell us if it was a directory if we only opened for- -- reading, so check again.- (fd_type,dev,ino) <- - case mb_stat of- Just x -> return x- Nothing -> fdStat fd-- case fd_type of- Directory -> - ioException (IOError Nothing InappropriateType "openFile"- "is a directory" Nothing) -- -- regular files need to be locked- RegularFile -> do-#ifndef mingw32_HOST_OS- -- On Windows we use explicit exclusion via sopen() to implement- -- this locking (see __hscore_open()); on Unix we have to- -- implment it in the RTS.- r <- lockFile fd dev ino (fromBool write)- when (r == -1) $- ioException (IOError Nothing ResourceBusy "openFile"- "file is locked" Nothing)-#endif- mkFileHandle fd is_stream filepath ha_type binary-- Stream- -- only *Streams* can be DuplexHandles. Other read/write- -- Handles must share a buffer.- | ReadWriteHandle <- ha_type -> - mkDuplexHandle fd is_stream filepath binary- | otherwise ->- mkFileHandle fd is_stream filepath ha_type binary-- RawDevice -> - mkFileHandle fd is_stream filepath ha_type binary---- | Old API kept to avoid breaking clients-fdToHandle' :: FD -> Maybe FDType -> Bool -> FilePath -> IOMode -> Bool- -> IO Handle-fdToHandle' fd mb_type is_socket filepath mode binary- = do- let mb_stat = case mb_type of- Nothing -> Nothing- -- fdToHandle_stat will do the stat:- Just RegularFile -> Nothing- -- no stat required for streams etc.:- Just other -> Just (other,0,0)- fdToHandle_stat fd mb_stat- is_socket -- set_non_blocking- False -- is_non_blocking- is_socket -- is_socket- filepath mode binary--fdToHandle :: FD -> IO Handle-fdToHandle fd = do- mode <- fdGetMode fd- let fd_str = "<file descriptor: " ++ show fd ++ ">"- fdToHandle_stat fd Nothing- False -- set_non_blocking- False -- is_non_blocking- False -- is_socket (guess XXX)- fd_str mode True{-bin mode-}--#ifndef mingw32_HOST_OS-foreign import ccall unsafe "lockFile"- lockFile :: CInt -> CDev -> CIno -> CInt -> IO CInt--foreign import ccall unsafe "unlockFile"- unlockFile :: CInt -> IO CInt-#endif--mkStdHandle :: FD -> FilePath -> HandleType -> IORef Buffer -> BufferMode- -> IO Handle-mkStdHandle fd filepath ha_type buf bmode = do- spares <- newIORef BufferListNil- newFileHandle filepath (stdHandleFinalizer filepath)- (Handle__ { haFD = fd,- haType = ha_type,- haIsBin = dEFAULT_OPEN_IN_BINARY_MODE,- haIsStream = False, -- means FD is blocking on Unix- haBufferMode = bmode,- haBuffer = buf,- haBuffers = spares,- haOtherSide = Nothing- })--mkFileHandle :: FD -> Bool -> FilePath -> HandleType -> Bool -> IO Handle-mkFileHandle fd is_stream filepath ha_type binary = do- (buf, bmode) <- getBuffer fd (initBufferState ha_type)--#ifdef mingw32_HOST_OS- -- On Windows, if this is a read/write handle and we are in text mode,- -- turn off buffering. We don't correctly handle the case of switching- -- from read mode to write mode on a buffered text-mode handle, see bug- -- \#679.- bmode2 <- case ha_type of- ReadWriteHandle | not binary -> return NoBuffering- _other -> return bmode-#else- let bmode2 = bmode-#endif-- spares <- newIORef BufferListNil- newFileHandle filepath (handleFinalizer filepath)- (Handle__ { haFD = fd,- haType = ha_type,- haIsBin = binary,- haIsStream = is_stream,- haBufferMode = bmode2,- haBuffer = buf,- haBuffers = spares,- haOtherSide = Nothing- })--mkDuplexHandle :: FD -> Bool -> FilePath -> Bool -> IO Handle-mkDuplexHandle fd is_stream filepath binary = do- (w_buf, w_bmode) <- getBuffer fd WriteBuffer- w_spares <- newIORef BufferListNil- let w_handle_ = - Handle__ { haFD = fd,- haType = WriteHandle,- haIsBin = binary,- haIsStream = is_stream,- haBufferMode = w_bmode,- haBuffer = w_buf,- haBuffers = w_spares,- haOtherSide = Nothing- }- write_side <- newMVar w_handle_-- (r_buf, r_bmode) <- getBuffer fd ReadBuffer- r_spares <- newIORef BufferListNil- let r_handle_ = - Handle__ { haFD = fd,- haType = ReadHandle,- haIsBin = binary,- haIsStream = is_stream,- haBufferMode = r_bmode,- haBuffer = r_buf,- haBuffers = r_spares,- haOtherSide = Just write_side- }- read_side <- newMVar r_handle_-- addMVarFinalizer write_side (handleFinalizer filepath write_side)- return (DuplexHandle filepath read_side write_side)- -initBufferState :: HandleType -> BufferState-initBufferState ReadHandle = ReadBuffer-initBufferState _ = WriteBuffer---- ------------------------------------------------------------------------------ Closing a handle---- | Computation 'hClose' @hdl@ makes handle @hdl@ closed. Before the--- computation finishes, if @hdl@ is writable its buffer is flushed as--- for 'hFlush'.--- Performing 'hClose' on a handle that has already been closed has no effect; --- doing so is not an error. All other operations on a closed handle will fail.--- If 'hClose' fails for any reason, any further operations (apart from--- 'hClose') on the handle will still fail as if @hdl@ had been successfully--- closed.--hClose :: Handle -> IO ()-hClose h@(FileHandle _ m) = do - mb_exc <- hClose' h m- case mb_exc of- Nothing -> return ()- Just e -> throwIO e-hClose h@(DuplexHandle _ r w) = do- mb_exc1 <- hClose' h w- mb_exc2 <- hClose' h r- case (do mb_exc1; mb_exc2) of- Nothing -> return ()- Just e -> throwIO e--hClose' :: Handle -> MVar Handle__ -> IO (Maybe SomeException)-hClose' h m = withHandle' "hClose" h m $ hClose_help---- hClose_help is also called by lazyRead (in PrelIO) when EOF is read--- or an IO error occurs on a lazy stream. The semi-closed Handle is--- then closed immediately. We have to be careful with DuplexHandles--- though: we have to leave the closing to the finalizer in that case,--- because the write side may still be in use.-hClose_help :: Handle__ -> IO (Handle__, Maybe SomeException)-hClose_help handle_ =- case haType handle_ of - ClosedHandle -> return (handle_,Nothing)- _ -> do flushWriteBufferOnly handle_ -- interruptible- hClose_handle_ handle_--hClose_handle_ :: Handle__ -> IO (Handle__, Maybe SomeException)-hClose_handle_ handle_ = do- let fd = haFD handle_-- -- close the file descriptor, but not when this is the read- -- side of a duplex handle.- -- If an exception is raised by the close(), we want to continue- -- to close the handle and release the lock if it has one, then - -- we return the exception to the caller of hClose_help which can- -- raise it if necessary.- maybe_exception <- - case haOtherSide handle_ of- Nothing -> (do- throwErrnoIfMinus1Retry_ "hClose" -#ifdef mingw32_HOST_OS- (closeFd (haIsStream handle_) fd)-#else- (c_close fd)-#endif- return Nothing- )- `catchException` \e -> return (Just e)-- Just _ -> return Nothing-- -- free the spare buffers- writeIORef (haBuffers handle_) BufferListNil- writeIORef (haBuffer handle_) noBuffer- -#ifndef mingw32_HOST_OS- -- unlock it- unlockFile fd-#endif-- -- we must set the fd to -1, because the finalizer is going- -- to run eventually and try to close/unlock it.- return (handle_{ haFD = -1, - haType = ClosedHandle- },- maybe_exception)--{-# NOINLINE noBuffer #-}-noBuffer :: Buffer-noBuffer = unsafePerformIO $ allocateBuffer 1 ReadBuffer---------------------------------------------------------------------------------- Detecting and changing the size of a file---- | For a handle @hdl@ which attached to a physical file,--- 'hFileSize' @hdl@ returns the size of that file in 8-bit bytes.--hFileSize :: Handle -> IO Integer-hFileSize handle =- withHandle_ "hFileSize" handle $ \ handle_ -> do- case haType handle_ of - ClosedHandle -> ioe_closedHandle- SemiClosedHandle -> ioe_closedHandle- _ -> do flushWriteBufferOnly handle_- r <- fdFileSize (haFD handle_)- if r /= -1- then return r- else ioException (IOError Nothing InappropriateType "hFileSize"- "not a regular file" Nothing)----- | 'hSetFileSize' @hdl@ @size@ truncates the physical file with handle @hdl@ to @size@ bytes.--hSetFileSize :: Handle -> Integer -> IO ()-hSetFileSize handle size =- withHandle_ "hSetFileSize" handle $ \ handle_ -> do- case haType handle_ of - ClosedHandle -> ioe_closedHandle- SemiClosedHandle -> ioe_closedHandle- _ -> do flushWriteBufferOnly handle_- throwErrnoIf (/=0) "hSetFileSize" - (c_ftruncate (haFD handle_) (fromIntegral size))- return ()---- ------------------------------------------------------------------------------ Detecting the End of Input---- | For a readable handle @hdl@, 'hIsEOF' @hdl@ returns--- 'True' if no further input can be taken from @hdl@ or for a--- physical file, if the current I\/O position is equal to the length of--- the file. Otherwise, it returns 'False'.------ NOTE: 'hIsEOF' may block, because it is the same as calling--- 'hLookAhead' and checking for an EOF exception.--hIsEOF :: Handle -> IO Bool-hIsEOF handle =- catch- (do hLookAhead handle; return False)- (\e -> if isEOFError e then return True else ioError e)---- | The computation 'isEOF' is identical to 'hIsEOF',--- except that it works only on 'stdin'.--isEOF :: IO Bool-isEOF = hIsEOF stdin---- ------------------------------------------------------------------------------ Looking ahead---- | Computation 'hLookAhead' returns the next character from the handle--- without removing it from the input buffer, blocking until a character--- is available.------ This operation may fail with:------ * 'isEOFError' if the end of file has been reached.--hLookAhead :: Handle -> IO Char-hLookAhead handle =- wantReadableHandle "hLookAhead" handle hLookAhead'--hLookAhead' :: Handle__ -> IO Char-hLookAhead' handle_ = do- let ref = haBuffer handle_- fd = haFD handle_- buf <- readIORef ref-- -- fill up the read buffer if necessary- new_buf <- if bufferEmpty buf- then fillReadBuffer fd True (haIsStream handle_) buf- else return buf-- writeIORef ref new_buf-- (c,_) <- readCharFromBuffer (bufBuf buf) (bufRPtr buf)- return c---- ------------------------------------------------------------------------------ Buffering Operations---- Three kinds of buffering are supported: line-buffering,--- block-buffering or no-buffering. See GHC.IOBase for definition and--- further explanation of what the type represent.---- | Computation 'hSetBuffering' @hdl mode@ sets the mode of buffering for--- handle @hdl@ on subsequent reads and writes.------ If the buffer mode is changed from 'BlockBuffering' or--- 'LineBuffering' to 'NoBuffering', then------ * if @hdl@ is writable, the buffer is flushed as for 'hFlush';------ * if @hdl@ is not writable, the contents of the buffer is discarded.------ This operation may fail with:------ * 'isPermissionError' if the handle has already been used for reading--- or writing and the implementation does not allow the buffering mode--- to be changed.--hSetBuffering :: Handle -> BufferMode -> IO ()-hSetBuffering handle mode =- withAllHandles__ "hSetBuffering" handle $ \ handle_ -> do- case haType handle_ of- ClosedHandle -> ioe_closedHandle- _ -> do- {- Note:- - we flush the old buffer regardless of whether- the new buffer could fit the contents of the old buffer - or not.- - allow a handle's buffering to change even if IO has- occurred (ANSI C spec. does not allow this, nor did- the previous implementation of IO.hSetBuffering).- - a non-standard extension is to allow the buffering- of semi-closed handles to change [sof 6/98]- -}- flushBuffer handle_-- let state = initBufferState (haType handle_)- new_buf <-- case mode of- -- we always have a 1-character read buffer for - -- unbuffered handles: it's needed to - -- support hLookAhead.- NoBuffering -> allocateBuffer 1 ReadBuffer- LineBuffering -> allocateBuffer dEFAULT_BUFFER_SIZE state- BlockBuffering Nothing -> allocateBuffer dEFAULT_BUFFER_SIZE state- BlockBuffering (Just n) | n <= 0 -> ioe_bufsiz n- | otherwise -> allocateBuffer n state- writeIORef (haBuffer handle_) new_buf-- -- for input terminals we need to put the terminal into- -- cooked or raw mode depending on the type of buffering.- is_tty <- fdIsTTY (haFD handle_)- when (is_tty && isReadableHandleType (haType handle_)) $- case mode of-#ifndef mingw32_HOST_OS- -- 'raw' mode under win32 is a bit too specialised (and troublesome- -- for most common uses), so simply disable its use here.- NoBuffering -> setCooked (haFD handle_) False-#else- NoBuffering -> return ()-#endif- _ -> setCooked (haFD handle_) True-- -- throw away spare buffers, they might be the wrong size- writeIORef (haBuffers handle_) BufferListNil-- return (handle_{ haBufferMode = mode })---- -------------------------------------------------------------------------------- hFlush---- | The action 'hFlush' @hdl@ causes any items buffered for output--- in handle @hdl@ to be sent immediately to the operating system.------ This operation may fail with:------ * 'isFullError' if the device is full;------ * 'isPermissionError' if a system resource limit would be exceeded.--- It is unspecified whether the characters in the buffer are discarded--- or retained under these circumstances.--hFlush :: Handle -> IO () -hFlush handle =- wantWritableHandle "hFlush" handle $ \ handle_ -> do- buf <- readIORef (haBuffer handle_)- if bufferIsWritable buf && not (bufferEmpty buf)- then do flushed_buf <- flushWriteBuffer (haFD handle_) (haIsStream handle_) buf- writeIORef (haBuffer handle_) flushed_buf- else return ()----- -------------------------------------------------------------------------------- Repositioning Handles--data HandlePosn = HandlePosn Handle HandlePosition--instance Eq HandlePosn where- (HandlePosn h1 p1) == (HandlePosn h2 p2) = p1==p2 && h1==h2--instance Show HandlePosn where- showsPrec p (HandlePosn h pos) = - showsPrec p h . showString " at position " . shows pos-- -- HandlePosition is the Haskell equivalent of POSIX' off_t.- -- We represent it as an Integer on the Haskell side, but- -- cheat slightly in that hGetPosn calls upon a C helper- -- that reports the position back via (merely) an Int.-type HandlePosition = Integer---- | Computation 'hGetPosn' @hdl@ returns the current I\/O position of--- @hdl@ as a value of the abstract type 'HandlePosn'.--hGetPosn :: Handle -> IO HandlePosn-hGetPosn handle = do- posn <- hTell handle- return (HandlePosn handle posn)---- | If a call to 'hGetPosn' @hdl@ returns a position @p@,--- then computation 'hSetPosn' @p@ sets the position of @hdl@--- to the position it held at the time of the call to 'hGetPosn'.------ This operation may fail with:------ * 'isPermissionError' if a system resource limit would be exceeded.--hSetPosn :: HandlePosn -> IO () -hSetPosn (HandlePosn h i) = hSeek h AbsoluteSeek i---- ------------------------------------------------------------------------------ hSeek---- | A mode that determines the effect of 'hSeek' @hdl mode i@, as follows:-data SeekMode- = AbsoluteSeek -- ^ the position of @hdl@ is set to @i@.- | RelativeSeek -- ^ the position of @hdl@ is set to offset @i@- -- from the current position.- | SeekFromEnd -- ^ the position of @hdl@ is set to offset @i@- -- from the end of the file.- deriving (Eq, Ord, Ix, Enum, Read, Show)--{- Note: - - when seeking using `SeekFromEnd', positive offsets (>=0) means- seeking at or past EOF.-- - we possibly deviate from the report on the issue of seeking within- the buffer and whether to flush it or not. The report isn't exactly- clear here.--}---- | Computation 'hSeek' @hdl mode i@ sets the position of handle--- @hdl@ depending on @mode@.--- The offset @i@ is given in terms of 8-bit bytes.------ If @hdl@ is block- or line-buffered, then seeking to a position which is not--- in the current buffer will first cause any items in the output buffer to be--- written to the device, and then cause the input buffer to be discarded.--- Some handles may not be seekable (see 'hIsSeekable'), or only support a--- subset of the possible positioning operations (for instance, it may only--- be possible to seek to the end of a tape, or to a positive offset from--- the beginning or current position).--- It is not possible to set a negative I\/O position, or for--- a physical file, an I\/O position beyond the current end-of-file.------ This operation may fail with:------ * 'isPermissionError' if a system resource limit would be exceeded.--hSeek :: Handle -> SeekMode -> Integer -> IO () -hSeek handle mode offset =- wantSeekableHandle "hSeek" handle $ \ handle_ -> do-# ifdef DEBUG_DUMP- puts ("hSeek " ++ show (mode,offset) ++ "\n")-# endif- let ref = haBuffer handle_- buf <- readIORef ref- let r = bufRPtr buf- w = bufWPtr buf- fd = haFD handle_-- let do_seek =- throwErrnoIfMinus1Retry_ "hSeek"- (c_lseek (haFD handle_) (fromIntegral offset) whence)-- whence :: CInt- whence = case mode of- AbsoluteSeek -> sEEK_SET- RelativeSeek -> sEEK_CUR- SeekFromEnd -> sEEK_END-- if bufferIsWritable buf- then do new_buf <- flushWriteBuffer fd (haIsStream handle_) buf- writeIORef ref new_buf- do_seek- else do-- if mode == RelativeSeek && offset >= 0 && offset < fromIntegral (w - r)- then writeIORef ref buf{ bufRPtr = r + fromIntegral offset }- else do -- new_buf <- flushReadBuffer (haFD handle_) buf- writeIORef ref new_buf- do_seek---hTell :: Handle -> IO Integer-hTell handle = - wantSeekableHandle "hGetPosn" handle $ \ handle_ -> do--#if defined(mingw32_HOST_OS)- -- urgh, on Windows we have to worry about \n -> \r\n translation, - -- so we can't easily calculate the file position using the- -- current buffer size. Just flush instead.- flushBuffer handle_-#endif- let fd = haFD handle_- posn <- fromIntegral `liftM`- throwErrnoIfMinus1Retry "hGetPosn"- (c_lseek fd 0 sEEK_CUR)-- let ref = haBuffer handle_- buf <- readIORef ref-- let real_posn - | bufferIsWritable buf = posn + fromIntegral (bufWPtr buf)- | otherwise = posn - fromIntegral (bufWPtr buf - bufRPtr buf)-# ifdef DEBUG_DUMP- puts ("\nhGetPosn: (fd, posn, real_posn) = " ++ show (fd, posn, real_posn) ++ "\n")- puts (" (bufWPtr, bufRPtr) = " ++ show (bufWPtr buf, bufRPtr buf) ++ "\n")-# endif- return real_posn---- -------------------------------------------------------------------------------- Handle Properties---- A number of operations return information about the properties of a--- handle. Each of these operations returns `True' if the handle has--- the specified property, and `False' otherwise.--hIsOpen :: Handle -> IO Bool-hIsOpen handle =- withHandle_ "hIsOpen" handle $ \ handle_ -> do- case haType handle_ of - ClosedHandle -> return False- SemiClosedHandle -> return False- _ -> return True--hIsClosed :: Handle -> IO Bool-hIsClosed handle =- withHandle_ "hIsClosed" handle $ \ handle_ -> do- case haType handle_ of - ClosedHandle -> return True- _ -> return False--{- not defined, nor exported, but mentioned- here for documentation purposes:-- hSemiClosed :: Handle -> IO Bool- hSemiClosed h = do- ho <- hIsOpen h- hc <- hIsClosed h- return (not (ho || hc))--}--hIsReadable :: Handle -> IO Bool-hIsReadable (DuplexHandle _ _ _) = return True-hIsReadable handle =- withHandle_ "hIsReadable" handle $ \ handle_ -> do- case haType handle_ of - ClosedHandle -> ioe_closedHandle- SemiClosedHandle -> ioe_closedHandle- htype -> return (isReadableHandleType htype)--hIsWritable :: Handle -> IO Bool-hIsWritable (DuplexHandle _ _ _) = return True-hIsWritable handle =- withHandle_ "hIsWritable" handle $ \ handle_ -> do- case haType handle_ of - ClosedHandle -> ioe_closedHandle- SemiClosedHandle -> ioe_closedHandle- htype -> return (isWritableHandleType htype)---- | Computation 'hGetBuffering' @hdl@ returns the current buffering mode--- for @hdl@.--hGetBuffering :: Handle -> IO BufferMode-hGetBuffering handle = - withHandle_ "hGetBuffering" handle $ \ handle_ -> do- case haType handle_ of - ClosedHandle -> ioe_closedHandle- _ -> - -- We're being non-standard here, and allow the buffering- -- of a semi-closed handle to be queried. -- sof 6/98- return (haBufferMode handle_) -- could be stricter..--hIsSeekable :: Handle -> IO Bool-hIsSeekable handle =- withHandle_ "hIsSeekable" handle $ \ handle_ -> do- case haType handle_ of - ClosedHandle -> ioe_closedHandle- SemiClosedHandle -> ioe_closedHandle- AppendHandle -> return False- _ -> do t <- fdType (haFD handle_)- return ((t == RegularFile || t == RawDevice)- && (haIsBin handle_ || tEXT_MODE_SEEK_ALLOWED))---- -------------------------------------------------------------------------------- Changing echo status (Non-standard GHC extensions)---- | Set the echoing status of a handle connected to a terminal.--hSetEcho :: Handle -> Bool -> IO ()-hSetEcho handle on = do- isT <- hIsTerminalDevice handle- if not isT- then return ()- else- withHandle_ "hSetEcho" handle $ \ handle_ -> do- case haType handle_ of - ClosedHandle -> ioe_closedHandle- _ -> setEcho (haFD handle_) on---- | Get the echoing status of a handle connected to a terminal.--hGetEcho :: Handle -> IO Bool-hGetEcho handle = do- isT <- hIsTerminalDevice handle- if not isT- then return False- else- withHandle_ "hGetEcho" handle $ \ handle_ -> do- case haType handle_ of - ClosedHandle -> ioe_closedHandle- _ -> getEcho (haFD handle_)---- | Is the handle connected to a terminal?--hIsTerminalDevice :: Handle -> IO Bool-hIsTerminalDevice handle = do- withHandle_ "hIsTerminalDevice" handle $ \ handle_ -> do- case haType handle_ of - ClosedHandle -> ioe_closedHandle- _ -> fdIsTTY (haFD handle_)---- -------------------------------------------------------------------------------- hSetBinaryMode---- | Select binary mode ('True') or text mode ('False') on a open handle.--- (See also 'openBinaryFile'.)--hSetBinaryMode :: Handle -> Bool -> IO ()-hSetBinaryMode handle bin =- withAllHandles__ "hSetBinaryMode" handle $ \ handle_ ->- do throwErrnoIfMinus1_ "hSetBinaryMode"- (setmode (haFD handle_) bin)- return handle_{haIsBin=bin}- -foreign import ccall unsafe "__hscore_setmode"- setmode :: CInt -> Bool -> IO CInt---- -------------------------------------------------------------------------------- Duplicating a Handle---- | Returns a duplicate of the original handle, with its own buffer.--- The two Handles will share a file pointer, however. The original--- handle's buffer is flushed, including discarding any input data,--- before the handle is duplicated.--hDuplicate :: Handle -> IO Handle-hDuplicate h@(FileHandle path m) = do- new_h_ <- withHandle' "hDuplicate" h m (dupHandle h Nothing)- newFileHandle path (handleFinalizer path) new_h_-hDuplicate h@(DuplexHandle path r w) = do- new_w_ <- withHandle' "hDuplicate" h w (dupHandle h Nothing)- new_w <- newMVar new_w_- new_r_ <- withHandle' "hDuplicate" h r (dupHandle h (Just new_w))- new_r <- newMVar new_r_- addMVarFinalizer new_w (handleFinalizer path new_w)- return (DuplexHandle path new_r new_w)--dupHandle :: Handle -> Maybe (MVar Handle__) -> Handle__- -> IO (Handle__, Handle__)-dupHandle h other_side h_ = do- -- flush the buffer first, so we don't have to copy its contents- flushBuffer h_- new_fd <- case other_side of- Nothing -> throwErrnoIfMinus1 "dupHandle" $ c_dup (haFD h_)- Just r -> withHandle_' "dupHandle" h r (return . haFD)- dupHandle_ other_side h_ new_fd--dupHandleTo :: Maybe (MVar Handle__) -> Handle__ -> Handle__- -> IO (Handle__, Handle__)-dupHandleTo other_side hto_ h_ = do- flushBuffer h_- -- Windows' dup2 does not return the new descriptor, unlike Unix- throwErrnoIfMinus1 "dupHandleTo" $ - c_dup2 (haFD h_) (haFD hto_)- dupHandle_ other_side h_ (haFD hto_)--dupHandle_ :: Maybe (MVar Handle__) -> Handle__ -> FD- -> IO (Handle__, Handle__)-dupHandle_ other_side h_ new_fd = do- buffer <- allocateBuffer dEFAULT_BUFFER_SIZE (initBufferState (haType h_))- ioref <- newIORef buffer- ioref_buffers <- newIORef BufferListNil-- let new_handle_ = h_{ haFD = new_fd, - haBuffer = ioref, - haBuffers = ioref_buffers,- haOtherSide = other_side }- return (h_, new_handle_)---- -------------------------------------------------------------------------------- Replacing a Handle--{- |-Makes the second handle a duplicate of the first handle. The second -handle will be closed first, if it is not already.--This can be used to retarget the standard Handles, for example:--> do h <- openFile "mystdout" WriteMode-> hDuplicateTo h stdout--}--hDuplicateTo :: Handle -> Handle -> IO ()-hDuplicateTo h1@(FileHandle _ m1) h2@(FileHandle _ m2) = do- withHandle__' "hDuplicateTo" h2 m2 $ \h2_ -> do- _ <- hClose_help h2_- withHandle' "hDuplicateTo" h1 m1 (dupHandleTo Nothing h2_)-hDuplicateTo h1@(DuplexHandle _ r1 w1) h2@(DuplexHandle _ r2 w2) = do- withHandle__' "hDuplicateTo" h2 w2 $ \w2_ -> do- _ <- hClose_help w2_- withHandle' "hDuplicateTo" h1 r1 (dupHandleTo Nothing w2_)- withHandle__' "hDuplicateTo" h2 r2 $ \r2_ -> do- _ <- hClose_help r2_- withHandle' "hDuplicateTo" h1 r1 (dupHandleTo (Just w1) r2_)-hDuplicateTo h1 _ =- ioException (IOError (Just h1) IllegalOperation "hDuplicateTo" - "handles are incompatible" Nothing)---- ------------------------------------------------------------------------------ showing Handles.------ | 'hShow' is in the 'IO' monad, and gives more comprehensive output--- than the (pure) instance of 'Show' for 'Handle'.--hShow :: Handle -> IO String-hShow h@(FileHandle path _) = showHandle' path False h-hShow h@(DuplexHandle path _ _) = showHandle' path True h--showHandle' :: String -> Bool -> Handle -> IO String-showHandle' filepath is_duplex h = - withHandle_ "showHandle" h $ \hdl_ ->- let- showType | is_duplex = showString "duplex (read-write)"- | otherwise = shows (haType hdl_)- in- return - (( showChar '{' . - showHdl (haType hdl_) - (showString "loc=" . showString filepath . showChar ',' .- showString "type=" . showType . showChar ',' .- showString "binary=" . shows (haIsBin hdl_) . showChar ',' .- showString "buffering=" . showBufMode (unsafePerformIO (readIORef (haBuffer hdl_))) (haBufferMode hdl_) . showString "}" )- ) "")- where-- showHdl :: HandleType -> ShowS -> ShowS- showHdl ht cont = - case ht of- ClosedHandle -> shows ht . showString "}"- _ -> cont-- showBufMode :: Buffer -> BufferMode -> ShowS- showBufMode buf bmo =- case bmo of- NoBuffering -> showString "none"- LineBuffering -> showString "line"- BlockBuffering (Just n) -> showString "block " . showParen True (shows n)- BlockBuffering Nothing -> showString "block " . showParen True (shows def)- where- def :: Int - def = bufSize buf---- ------------------------------------------------------------------------------ debugging--#if defined(DEBUG_DUMP)-puts :: String -> IO ()-puts s = do write_rawBuffer 1 (unsafeCoerce# (packCString# s)) 0 (fromIntegral (length s))- return ()-#endif---- -------------------------------------------------------------------------------- utils--throwErrnoIfMinus1RetryOnBlock :: String -> IO CInt -> IO CInt -> IO CInt-throwErrnoIfMinus1RetryOnBlock loc f on_block = - do- res <- f- if (res :: CInt) == -1- then do- err <- getErrno- if err == eINTR- then throwErrnoIfMinus1RetryOnBlock loc f on_block- else if err == eWOULDBLOCK || err == eAGAIN- then do on_block- else throwErrno loc- else return res---- -------------------------------------------------------------------------------- wrappers to platform-specific constants:--foreign import ccall unsafe "__hscore_supportsTextMode"- tEXT_MODE_SEEK_ALLOWED :: Bool--foreign import ccall unsafe "__hscore_bufsiz" dEFAULT_BUFFER_SIZE :: Int-foreign import ccall unsafe "__hscore_seek_cur" sEEK_CUR :: CInt-foreign import ccall unsafe "__hscore_seek_set" sEEK_SET :: CInt-foreign import ccall unsafe "__hscore_seek_end" sEEK_END :: CInt+{-# OPTIONS_HADDOCK hide #-}+-----------------------------------------------------------------------------+-- |+-- Module : GHC.Handle+-- Copyright : (c) The University of Glasgow, 1994-2001+-- License : see libraries/base/LICENSE+-- +-- Maintainer : libraries@haskell.org+-- Stability : internal+-- Portability : non-portable+--+-- Backwards-compatibility interface+--+-----------------------------------------------------------------------------++-- #hide++module GHC.Handle {-# DEPRECATED "use GHC.IO.Handle.Base instead" #-} (+ withHandle, withHandle', withHandle_,+ wantWritableHandle, wantReadableHandle, wantSeekableHandle,++-- newEmptyBuffer, allocateBuffer, readCharFromBuffer, writeCharIntoBuffer,+-- flushWriteBufferOnly, flushWriteBuffer,+-- flushReadBuffer,+-- fillReadBuffer, fillReadBufferWithoutBlocking,+-- readRawBuffer, readRawBufferPtr,+-- readRawBufferNoBlock, readRawBufferPtrNoBlock,+-- writeRawBuffer, writeRawBufferPtr,++ ioe_closedHandle, ioe_EOF, ioe_notReadable, ioe_notWritable,++ stdin, stdout, stderr,+ IOMode(..), openFile, openBinaryFile, +-- fdToHandle_stat,+ fdToHandle, fdToHandle',+ hFileSize, hSetFileSize, hIsEOF, isEOF, hLookAhead, hLookAhead_, + hSetBuffering, hSetBinaryMode,+ hFlush, hDuplicate, hDuplicateTo,++ hClose, hClose_help,++ HandlePosition, HandlePosn(..), hGetPosn, hSetPosn,+ SeekMode(..), hSeek, hTell,++ hIsOpen, hIsClosed, hIsReadable, hIsWritable, hGetBuffering, hIsSeekable,+ hSetEcho, hGetEcho, hIsTerminalDevice,++ hShow,++ ) where++import GHC.IO.IOMode+import GHC.IO.Handle+import GHC.IO.Handle.Internals+import GHC.IO.Handle.FD
− GHC/Handle.hs-boot
@@ -1,9 +0,0 @@-{-# OPTIONS_GHC -XNoImplicitPrelude #-}--module GHC.Handle where--import GHC.IOBase--stdout :: Handle-stderr :: Handle-hFlush :: Handle -> IO ()
GHC/IO.hs view
@@ -1,974 +1,339 @@-{-# OPTIONS_GHC -XNoImplicitPrelude -#include "HsBase.h" #-}-{-# OPTIONS_HADDOCK hide #-}--#undef DEBUG_DUMP---------------------------------------------------------------------------------- |--- Module : GHC.IO--- Copyright : (c) The University of Glasgow, 1992-2001--- License : see libraries/base/LICENSE--- --- Maintainer : libraries@haskell.org--- Stability : internal--- Portability : non-portable------ String I\/O functions------------------------------------------------------------------------------------- #hide-module GHC.IO ( - hWaitForInput, hGetChar, hGetLine, hGetContents, hPutChar, hPutStr,- commitBuffer', -- hack, see below- hGetcBuffered, -- needed by ghc/compiler/utils/StringBuffer.lhs- hGetBuf, hGetBufNonBlocking, hPutBuf, hPutBufNonBlocking, slurpFile,- memcpy_ba_baoff,- memcpy_ptr_baoff,- memcpy_baoff_ba,- memcpy_baoff_ptr,- ) where--import Foreign-import Foreign.C--import System.IO.Error-import Data.Maybe-import Control.Monad-#ifndef mingw32_HOST_OS-import System.Posix.Internals-#endif--import GHC.Enum-import GHC.Base-import GHC.IOBase-import GHC.Handle -- much of the real stuff is in here-import GHC.Real-import GHC.Num-import GHC.Show-import GHC.List--#ifdef mingw32_HOST_OS-import GHC.Conc-#endif---- ------------------------------------------------------------------------------ Simple input operations---- If hWaitForInput finds anything in the Handle's buffer, it--- immediately returns. If not, it tries to read from the underlying--- OS handle. Notice that for buffered Handles connected to terminals--- this means waiting until a complete line is available.---- | Computation 'hWaitForInput' @hdl t@--- waits until input is available on handle @hdl@.--- It returns 'True' as soon as input is available on @hdl@,--- or 'False' if no input is available within @t@ milliseconds.------ If @t@ is less than zero, then @hWaitForInput@ waits indefinitely.------ This operation may fail with:------ * 'isEOFError' if the end of file has been reached.------ NOTE for GHC users: unless you use the @-threaded@ flag,--- @hWaitForInput t@ where @t >= 0@ will block all other Haskell--- threads for the duration of the call. It behaves like a--- @safe@ foreign call in this respect.--hWaitForInput :: Handle -> Int -> IO Bool-hWaitForInput h msecs = do- wantReadableHandle "hWaitForInput" h $ \ handle_ -> do- let ref = haBuffer handle_- buf <- readIORef ref-- if not (bufferEmpty buf)- then return True- else do-- if msecs < 0 - then do buf' <- fillReadBuffer (haFD handle_) True - (haIsStream handle_) buf- writeIORef ref buf'- return True- else do r <- throwErrnoIfMinus1Retry "hWaitForInput" $- fdReady (haFD handle_) 0 {- read -}- (fromIntegral msecs)- (fromIntegral $ fromEnum $ haIsStream handle_)- if r /= 0 then do -- Call hLookAhead' to throw an EOF- -- exception if appropriate- hLookAhead' handle_- return True- else return False--foreign import ccall safe "fdReady"- fdReady :: CInt -> CInt -> CInt -> CInt -> IO CInt---- ------------------------------------------------------------------------------ hGetChar---- | Computation 'hGetChar' @hdl@ reads a character from the file or--- channel managed by @hdl@, blocking until a character is available.------ This operation may fail with:------ * 'isEOFError' if the end of file has been reached.--hGetChar :: Handle -> IO Char-hGetChar handle =- wantReadableHandle "hGetChar" handle $ \handle_ -> do-- let fd = haFD handle_- ref = haBuffer handle_-- buf <- readIORef ref- if not (bufferEmpty buf)- then hGetcBuffered fd ref buf- else do-- -- buffer is empty.- case haBufferMode handle_ of- LineBuffering -> do- new_buf <- fillReadBuffer fd True (haIsStream handle_) buf- hGetcBuffered fd ref new_buf- BlockBuffering _ -> do- new_buf <- fillReadBuffer fd True (haIsStream handle_) buf- -- ^^^^- -- don't wait for a completely full buffer.- hGetcBuffered fd ref new_buf- NoBuffering -> do- -- make use of the minimal buffer we already have- let raw = bufBuf buf- r <- readRawBuffer "hGetChar" fd (haIsStream handle_) raw 0 1- if r == 0- then ioe_EOF- else do (c,_) <- readCharFromBuffer raw 0- return c--hGetcBuffered :: FD -> IORef Buffer -> Buffer -> IO Char-hGetcBuffered _ ref buf@Buffer{ bufBuf=b, bufRPtr=r0, bufWPtr=w }- = do (c, r) <- readCharFromBuffer b r0- let new_buf | r == w = buf{ bufRPtr=0, bufWPtr=0 }- | otherwise = buf{ bufRPtr=r }- writeIORef ref new_buf- return c---- ------------------------------------------------------------------------------ hGetLine---- ToDo: the unbuffered case is wrong: it doesn't lock the handle for--- the duration.---- | Computation 'hGetLine' @hdl@ reads a line from the file or--- channel managed by @hdl@.------ This operation may fail with:------ * 'isEOFError' if the end of file is encountered when reading--- the /first/ character of the line.------ If 'hGetLine' encounters end-of-file at any other point while reading--- in a line, it is treated as a line terminator and the (partial)--- line is returned.--hGetLine :: Handle -> IO String-hGetLine h = do- m <- wantReadableHandle "hGetLine" h $ \ handle_ -> do- case haBufferMode handle_ of- NoBuffering -> return Nothing- LineBuffering -> do- l <- hGetLineBuffered handle_- return (Just l)- BlockBuffering _ -> do - l <- hGetLineBuffered handle_- return (Just l)- case m of- Nothing -> hGetLineUnBuffered h- Just l -> return l--hGetLineBuffered :: Handle__ -> IO String-hGetLineBuffered handle_ = do- let ref = haBuffer handle_- buf <- readIORef ref- hGetLineBufferedLoop handle_ ref buf []--hGetLineBufferedLoop :: Handle__ -> IORef Buffer -> Buffer -> [String]- -> IO String-hGetLineBufferedLoop handle_ ref- buf@Buffer{ bufRPtr=r0, bufWPtr=w, bufBuf=raw0 } xss =- let- -- find the end-of-line character, if there is one- loop raw r- | r == w = return (False, w)- | otherwise = do- (c,r') <- readCharFromBuffer raw r- if c == '\n'- then return (True, r) -- NB. not r': don't include the '\n'- else loop raw r'- in do- (eol, off) <- loop raw0 r0--#ifdef DEBUG_DUMP- puts ("hGetLineBufferedLoop: r=" ++ show r0 ++ ", w=" ++ show w ++ ", off=" ++ show off ++ "\n")-#endif-- xs <- unpack raw0 r0 off-- -- if eol == True, then off is the offset of the '\n'- -- otherwise off == w and the buffer is now empty.- if eol- then do if (w == off + 1)- then writeIORef ref buf{ bufRPtr=0, bufWPtr=0 }- else writeIORef ref buf{ bufRPtr = off + 1 }- return (concat (reverse (xs:xss)))- else do- maybe_buf <- maybeFillReadBuffer (haFD handle_) True (haIsStream handle_)- buf{ bufWPtr=0, bufRPtr=0 }- case maybe_buf of- -- Nothing indicates we caught an EOF, and we may have a- -- partial line to return.- Nothing -> do- writeIORef ref buf{ bufRPtr=0, bufWPtr=0 }- let str = concat (reverse (xs:xss))- if not (null str)- then return str- else ioe_EOF- Just new_buf ->- hGetLineBufferedLoop handle_ ref new_buf (xs:xss)--maybeFillReadBuffer :: FD -> Bool -> Bool -> Buffer -> IO (Maybe Buffer)-maybeFillReadBuffer fd is_line is_stream buf- = catch - (do buf' <- fillReadBuffer fd is_line is_stream buf- return (Just buf')- )- (\e -> do if isEOFError e - then return Nothing - else ioError e)---unpack :: RawBuffer -> Int -> Int -> IO [Char]-unpack _ _ 0 = return ""-unpack buf (I# r) (I# len) = IO $ \s -> unpackRB [] (len -# 1#) s- where- unpackRB acc i s- | i <# r = (# s, acc #)- | otherwise = - case readCharArray# buf i s of- (# s', ch #) -> unpackRB (C# ch : acc) (i -# 1#) s'---hGetLineUnBuffered :: Handle -> IO String-hGetLineUnBuffered h = do- c <- hGetChar h- if c == '\n' then- return ""- else do- l <- getRest- return (c:l)- where- getRest = do- c <- - catch - (hGetChar h)- (\ err -> do- if isEOFError err then- return '\n'- else- ioError err)- if c == '\n' then- return ""- else do- s <- getRest- return (c:s)---- -------------------------------------------------------------------------------- hGetContents---- hGetContents on a DuplexHandle only affects the read side: you can--- carry on writing to it afterwards.---- | Computation 'hGetContents' @hdl@ returns the list of characters--- corresponding to the unread portion of the channel or file managed--- by @hdl@, which is put into an intermediate state, /semi-closed/.--- In this state, @hdl@ is effectively closed,--- but items are read from @hdl@ on demand and accumulated in a special--- list returned by 'hGetContents' @hdl@.------ Any operation that fails because a handle is closed,--- also fails if a handle is semi-closed. The only exception is 'hClose'.--- A semi-closed handle becomes closed:------ * if 'hClose' is applied to it;------ * if an I\/O error occurs when reading an item from the handle;------ * or once the entire contents of the handle has been read.------ Once a semi-closed handle becomes closed, the contents of the--- associated list becomes fixed. The contents of this final list is--- only partially specified: it will contain at least all the items of--- the stream that were evaluated prior to the handle becoming closed.------ Any I\/O errors encountered while a handle is semi-closed are simply--- discarded.------ This operation may fail with:------ * 'isEOFError' if the end of file has been reached.--hGetContents :: Handle -> IO String-hGetContents handle = - withHandle "hGetContents" handle $ \handle_ ->- case haType handle_ of - ClosedHandle -> ioe_closedHandle- SemiClosedHandle -> ioe_closedHandle- AppendHandle -> ioe_notReadable- WriteHandle -> ioe_notReadable- _ -> do xs <- lazyRead handle- return (handle_{ haType=SemiClosedHandle}, xs )---- Note that someone may close the semi-closed handle (or change its--- buffering), so each time these lazy read functions are pulled on,--- they have to check whether the handle has indeed been closed.--lazyRead :: Handle -> IO String-lazyRead handle = - unsafeInterleaveIO $- withHandle "lazyRead" handle $ \ handle_ -> do- case haType handle_ of- ClosedHandle -> return (handle_, "")- SemiClosedHandle -> lazyRead' handle handle_- _ -> ioException - (IOError (Just handle) IllegalOperation "lazyRead"- "illegal handle type" Nothing)--lazyRead' :: Handle -> Handle__ -> IO (Handle__, [Char])-lazyRead' h handle_ = do- let ref = haBuffer handle_- fd = haFD handle_-- -- even a NoBuffering handle can have a char in the buffer... - -- (see hLookAhead)- buf <- readIORef ref- if not (bufferEmpty buf)- then lazyReadHaveBuffer h handle_ fd ref buf- else do-- case haBufferMode handle_ of- NoBuffering -> do- -- make use of the minimal buffer we already have- let raw = bufBuf buf- r <- readRawBuffer "lazyRead" fd (haIsStream handle_) raw 0 1- if r == 0- then do (handle_', _) <- hClose_help handle_ - return (handle_', "")- else do (c,_) <- readCharFromBuffer raw 0- rest <- lazyRead h- return (handle_, c : rest)-- LineBuffering -> lazyReadBuffered h handle_ fd ref buf- BlockBuffering _ -> lazyReadBuffered h handle_ fd ref buf---- we never want to block during the read, so we call fillReadBuffer with--- is_line==True, which tells it to "just read what there is".-lazyReadBuffered :: Handle -> Handle__ -> FD -> IORef Buffer -> Buffer- -> IO (Handle__, [Char])-lazyReadBuffered h handle_ fd ref buf = do- catch - (do buf' <- fillReadBuffer fd True{-is_line-} (haIsStream handle_) buf- lazyReadHaveBuffer h handle_ fd ref buf'- )- -- all I/O errors are discarded. Additionally, we close the handle.- (\_ -> do (handle_', _) <- hClose_help handle_- return (handle_', "")- )--lazyReadHaveBuffer :: Handle -> Handle__ -> FD -> IORef Buffer -> Buffer -> IO (Handle__, [Char])-lazyReadHaveBuffer h handle_ _ ref buf = do- more <- lazyRead h- writeIORef ref buf{ bufRPtr=0, bufWPtr=0 }- s <- unpackAcc (bufBuf buf) (bufRPtr buf) (bufWPtr buf) more- return (handle_, s)---unpackAcc :: RawBuffer -> Int -> Int -> [Char] -> IO [Char]-unpackAcc _ _ 0 acc = return acc-unpackAcc buf (I# r) (I# len) acc0 = IO $ \s -> unpackRB acc0 (len -# 1#) s- where- unpackRB acc i s- | i <# r = (# s, acc #)- | otherwise = - case readCharArray# buf i s of- (# s', ch #) -> unpackRB (C# ch : acc) (i -# 1#) s'---- ------------------------------------------------------------------------------ hPutChar---- | Computation 'hPutChar' @hdl ch@ writes the character @ch@ to the--- file or channel managed by @hdl@. Characters may be buffered if--- buffering is enabled for @hdl@.------ This operation may fail with:------ * 'isFullError' if the device is full; or------ * 'isPermissionError' if another system resource limit would be exceeded.--hPutChar :: Handle -> Char -> IO ()-hPutChar handle c = do- c `seq` return ()- wantWritableHandle "hPutChar" handle $ \ handle_ -> do- let fd = haFD handle_- case haBufferMode handle_ of- LineBuffering -> hPutcBuffered handle_ True c- BlockBuffering _ -> hPutcBuffered handle_ False c- NoBuffering ->- with (castCharToCChar c) $ \buf -> do- writeRawBufferPtr "hPutChar" fd (haIsStream handle_) buf 0 1- return ()--hPutcBuffered :: Handle__ -> Bool -> Char -> IO ()-hPutcBuffered handle_ is_line c = do- let ref = haBuffer handle_- buf <- readIORef ref- let w = bufWPtr buf- w' <- writeCharIntoBuffer (bufBuf buf) w c- let new_buf = buf{ bufWPtr = w' }- if bufferFull new_buf || is_line && c == '\n'- then do - flushed_buf <- flushWriteBuffer (haFD handle_) (haIsStream handle_) new_buf- writeIORef ref flushed_buf- else do - writeIORef ref new_buf---hPutChars :: Handle -> [Char] -> IO ()-hPutChars _ [] = return ()-hPutChars handle (c:cs) = hPutChar handle c >> hPutChars handle cs---- ------------------------------------------------------------------------------ hPutStr---- We go to some trouble to avoid keeping the handle locked while we're--- evaluating the string argument to hPutStr, in case doing so triggers another--- I/O operation on the same handle which would lead to deadlock. The classic--- case is------ putStr (trace "hello" "world")------ so the basic scheme is this:------ * copy the string into a fresh buffer,--- * "commit" the buffer to the handle.------ Committing may involve simply copying the contents of the new--- buffer into the handle's buffer, flushing one or both buffers, or--- maybe just swapping the buffers over (if the handle's buffer was--- empty). See commitBuffer below.---- | Computation 'hPutStr' @hdl s@ writes the string--- @s@ to the file or channel managed by @hdl@.------ This operation may fail with:------ * 'isFullError' if the device is full; or------ * 'isPermissionError' if another system resource limit would be exceeded.--hPutStr :: Handle -> String -> IO ()-hPutStr handle str = do- buffer_mode <- wantWritableHandle "hPutStr" handle - (\ handle_ -> do getSpareBuffer handle_)- case buffer_mode of- (NoBuffering, _) -> do- hPutChars handle str -- v. slow, but we don't care- (LineBuffering, buf) -> do- writeLines handle buf str- (BlockBuffering _, buf) -> do- writeBlocks handle buf str---getSpareBuffer :: Handle__ -> IO (BufferMode, Buffer)-getSpareBuffer Handle__{haBuffer=ref, - haBuffers=spare_ref,- haBufferMode=mode}- = do- case mode of- NoBuffering -> return (mode, error "no buffer!")- _ -> do- bufs <- readIORef spare_ref- buf <- readIORef ref- case bufs of- BufferListCons b rest -> do- writeIORef spare_ref rest- return ( mode, newEmptyBuffer b WriteBuffer (bufSize buf))- BufferListNil -> do- new_buf <- allocateBuffer (bufSize buf) WriteBuffer- return (mode, new_buf)---writeLines :: Handle -> Buffer -> String -> IO ()-writeLines hdl Buffer{ bufBuf=raw, bufSize=len } s =- let- shoveString :: Int -> [Char] -> IO ()- -- check n == len first, to ensure that shoveString is strict in n.- shoveString n cs | n == len = do- new_buf <- commitBuffer hdl raw len n True{-needs flush-} False- writeLines hdl new_buf cs- shoveString n [] = do- commitBuffer hdl raw len n False{-no flush-} True{-release-}- return ()- shoveString n (c:cs) = do- n' <- writeCharIntoBuffer raw n c- if (c == '\n') - then do - new_buf <- commitBuffer hdl raw len n' True{-needs flush-} False- writeLines hdl new_buf cs- else - shoveString n' cs- in- shoveString 0 s--writeBlocks :: Handle -> Buffer -> String -> IO ()-writeBlocks hdl Buffer{ bufBuf=raw, bufSize=len } s =- let- shoveString :: Int -> [Char] -> IO ()- -- check n == len first, to ensure that shoveString is strict in n.- shoveString n cs | n == len = do- new_buf <- commitBuffer hdl raw len n True{-needs flush-} False- writeBlocks hdl new_buf cs- shoveString n [] = do- commitBuffer hdl raw len n False{-no flush-} True{-release-}- return ()- shoveString n (c:cs) = do- n' <- writeCharIntoBuffer raw n c- shoveString n' cs- in- shoveString 0 s---- -------------------------------------------------------------------------------- commitBuffer handle buf sz count flush release--- --- Write the contents of the buffer 'buf' ('sz' bytes long, containing--- 'count' bytes of data) to handle (handle must be block or line buffered).--- --- Implementation:--- --- for block/line buffering,--- 1. If there isn't room in the handle buffer, flush the handle--- buffer.--- --- 2. If the handle buffer is empty,--- if flush, --- then write buf directly to the device.--- else swap the handle buffer with buf.--- --- 3. If the handle buffer is non-empty, copy buf into the--- handle buffer. Then, if flush != 0, flush--- the buffer.--commitBuffer- :: Handle -- handle to commit to- -> RawBuffer -> Int -- address and size (in bytes) of buffer- -> Int -- number of bytes of data in buffer- -> Bool -- True <=> flush the handle afterward- -> Bool -- release the buffer?- -> IO Buffer--commitBuffer hdl raw sz@(I# _) count@(I# _) flush release = do- wantWritableHandle "commitAndReleaseBuffer" hdl $- commitBuffer' raw sz count flush release---- Explicitly lambda-lift this function to subvert GHC's full laziness--- optimisations, which otherwise tends to float out subexpressions--- past the \handle, which is really a pessimisation in this case because--- that lambda is a one-shot lambda.------ Don't forget to export the function, to stop it being inlined too--- (this appears to be better than NOINLINE, because the strictness--- analyser still gets to worker-wrapper it).------ This hack is a fairly big win for hPutStr performance. --SDM 18/9/2001----commitBuffer' :: RawBuffer -> Int -> Int -> Bool -> Bool -> Handle__- -> IO Buffer-commitBuffer' raw sz@(I# _) count@(I# _) flush release- handle_@Handle__{ haFD=fd, haBuffer=ref, haBuffers=spare_buf_ref } = do--#ifdef DEBUG_DUMP- puts ("commitBuffer: sz=" ++ show sz ++ ", count=" ++ show count- ++ ", flush=" ++ show flush ++ ", release=" ++ show release ++"\n")-#endif-- old_buf@Buffer{ bufBuf=old_raw, bufWPtr=w, bufSize=size }- <- readIORef ref-- buf_ret <-- -- enough room in handle buffer?- if (not flush && (size - w > count))- -- The > is to be sure that we never exactly fill- -- up the buffer, which would require a flush. So- -- if copying the new data into the buffer would- -- make the buffer full, we just flush the existing- -- buffer and the new data immediately, rather than- -- copying before flushing.-- -- not flushing, and there's enough room in the buffer:- -- just copy the data in and update bufWPtr.- then do memcpy_baoff_ba old_raw (fromIntegral w) raw (fromIntegral count)- writeIORef ref old_buf{ bufWPtr = w + count }- return (newEmptyBuffer raw WriteBuffer sz)-- -- else, we have to flush- else do flushed_buf <- flushWriteBuffer fd (haIsStream handle_) old_buf-- let this_buf = - Buffer{ bufBuf=raw, bufState=WriteBuffer, - bufRPtr=0, bufWPtr=count, bufSize=sz }-- -- if: (a) we don't have to flush, and- -- (b) size(new buffer) == size(old buffer), and- -- (c) new buffer is not full,- -- we can just just swap them over...- if (not flush && sz == size && count /= sz)- then do - writeIORef ref this_buf- return flushed_buf -- -- otherwise, we have to flush the new data too,- -- and start with a fresh buffer- else do- flushWriteBuffer fd (haIsStream handle_) this_buf- writeIORef ref flushed_buf- -- if the sizes were different, then allocate- -- a new buffer of the correct size.- if sz == size- then return (newEmptyBuffer raw WriteBuffer sz)- else allocateBuffer size WriteBuffer-- -- release the buffer if necessary- case buf_ret of- Buffer{ bufSize=buf_ret_sz, bufBuf=buf_ret_raw } -> do- if release && buf_ret_sz == size- then do- spare_bufs <- readIORef spare_buf_ref- writeIORef spare_buf_ref - (BufferListCons buf_ret_raw spare_bufs)- return buf_ret- else- return buf_ret---- ------------------------------------------------------------------------------ Reading/writing sequences of bytes.---- ------------------------------------------------------------------------------ hPutBuf---- | 'hPutBuf' @hdl buf count@ writes @count@ 8-bit bytes from the--- buffer @buf@ to the handle @hdl@. It returns ().------ This operation may fail with:------ * 'ResourceVanished' if the handle is a pipe or socket, and the--- reading end is closed. (If this is a POSIX system, and the program--- has not asked to ignore SIGPIPE, then a SIGPIPE may be delivered--- instead, whose default action is to terminate the program).--hPutBuf :: Handle -- handle to write to- -> Ptr a -- address of buffer- -> Int -- number of bytes of data in buffer- -> IO ()-hPutBuf h ptr count = do hPutBuf' h ptr count True; return ()--hPutBufNonBlocking- :: Handle -- handle to write to- -> Ptr a -- address of buffer- -> Int -- number of bytes of data in buffer- -> IO Int -- returns: number of bytes written-hPutBufNonBlocking h ptr count = hPutBuf' h ptr count False--hPutBuf':: Handle -- handle to write to- -> Ptr a -- address of buffer- -> Int -- number of bytes of data in buffer- -> Bool -- allow blocking?- -> IO Int-hPutBuf' handle ptr count can_block- | count == 0 = return 0- | count < 0 = illegalBufferSize handle "hPutBuf" count- | otherwise = - wantWritableHandle "hPutBuf" handle $ - \ Handle__{ haFD=fd, haBuffer=ref, haIsStream=is_stream } -> - bufWrite fd ref is_stream ptr count can_block--bufWrite :: FD -> IORef Buffer -> Bool -> Ptr a -> Int -> Bool -> IO Int-bufWrite fd ref is_stream ptr count can_block =- seq count $ seq fd $ do -- strictness hack- old_buf@Buffer{ bufBuf=old_raw, bufWPtr=w, bufSize=size }- <- readIORef ref-- -- enough room in handle buffer?- if (size - w > count)- -- There's enough room in the buffer:- -- just copy the data in and update bufWPtr.- then do memcpy_baoff_ptr old_raw (fromIntegral w) ptr (fromIntegral count)- writeIORef ref old_buf{ bufWPtr = w + count }- return count-- -- else, we have to flush- else do flushed_buf <- flushWriteBuffer fd is_stream old_buf- -- TODO: we should do a non-blocking flush here- writeIORef ref flushed_buf- -- if we can fit in the buffer, then just loop - if count < size- then bufWrite fd ref is_stream ptr count can_block- else if can_block- then do writeChunk fd is_stream (castPtr ptr) count- return count- else writeChunkNonBlocking fd is_stream ptr count--writeChunk :: FD -> Bool -> Ptr CChar -> Int -> IO ()-writeChunk fd is_stream ptr bytes0 = loop 0 bytes0- where- loop :: Int -> Int -> IO ()- loop _ bytes | bytes <= 0 = return ()- loop off bytes = do- r <- fromIntegral `liftM`- writeRawBufferPtr "writeChunk" fd is_stream ptr- off (fromIntegral bytes)- -- write can't return 0- loop (off + r) (bytes - r)--writeChunkNonBlocking :: FD -> Bool -> Ptr a -> Int -> IO Int-writeChunkNonBlocking fd-#ifndef mingw32_HOST_OS- _-#else- is_stream-#endif- ptr bytes0 = loop 0 bytes0- where- loop :: Int -> Int -> IO Int- loop off bytes | bytes <= 0 = return off- loop off bytes = do-#ifndef mingw32_HOST_OS- ssize <- c_write fd (ptr `plusPtr` off) (fromIntegral bytes)- let r = fromIntegral ssize :: Int- if (r == -1)- then do errno <- getErrno- if (errno == eAGAIN || errno == eWOULDBLOCK)- then return off- else throwErrno "writeChunk"- else loop (off + r) (bytes - r)-#else- (ssize, rc) <- asyncWrite (fromIntegral fd)- (fromIntegral $ fromEnum is_stream)- (fromIntegral bytes)- (ptr `plusPtr` off)- let r = fromIntegral ssize :: Int- if r == (-1)- then ioError (errnoToIOError "hPutBufNonBlocking" (Errno (fromIntegral rc)) Nothing Nothing)- else loop (off + r) (bytes - r)-#endif---- ------------------------------------------------------------------------------ hGetBuf---- | 'hGetBuf' @hdl buf count@ reads data from the handle @hdl@--- into the buffer @buf@ until either EOF is reached or--- @count@ 8-bit bytes have been read.--- It returns the number of bytes actually read. This may be zero if--- EOF was reached before any data was read (or if @count@ is zero).------ 'hGetBuf' never raises an EOF exception, instead it returns a value--- smaller than @count@.------ If the handle is a pipe or socket, and the writing end--- is closed, 'hGetBuf' will behave as if EOF was reached.--hGetBuf :: Handle -> Ptr a -> Int -> IO Int-hGetBuf h ptr count- | count == 0 = return 0- | count < 0 = illegalBufferSize h "hGetBuf" count- | otherwise = - wantReadableHandle "hGetBuf" h $ - \ Handle__{ haFD=fd, haBuffer=ref, haIsStream=is_stream } -> do- bufRead fd ref is_stream ptr 0 count---- small reads go through the buffer, large reads are satisfied by--- taking data first from the buffer and then direct from the file--- descriptor.-bufRead :: FD -> IORef Buffer -> Bool -> Ptr a -> Int -> Int -> IO Int-bufRead fd ref is_stream ptr so_far count =- seq fd $ seq so_far $ seq count $ do -- strictness hack- buf@Buffer{ bufBuf=raw, bufWPtr=w, bufRPtr=r, bufSize=sz } <- readIORef ref- if bufferEmpty buf- then if count > sz -- small read?- then do rest <- readChunk fd is_stream ptr count- return (so_far + rest)- else do mb_buf <- maybeFillReadBuffer fd True is_stream buf- case mb_buf of- Nothing -> return so_far -- got nothing, we're done- Just buf' -> do- writeIORef ref buf'- bufRead fd ref is_stream ptr so_far count- else do - let avail = w - r- if (count == avail)- then do - memcpy_ptr_baoff ptr raw (fromIntegral r) (fromIntegral count)- writeIORef ref buf{ bufWPtr=0, bufRPtr=0 }- return (so_far + count)- else do- if (count < avail)- then do - memcpy_ptr_baoff ptr raw (fromIntegral r) (fromIntegral count)- writeIORef ref buf{ bufRPtr = r + count }- return (so_far + count)- else do- - memcpy_ptr_baoff ptr raw (fromIntegral r) (fromIntegral avail)- writeIORef ref buf{ bufWPtr=0, bufRPtr=0 }- let remaining = count - avail- so_far' = so_far + avail- ptr' = ptr `plusPtr` avail-- if remaining < sz- then bufRead fd ref is_stream ptr' so_far' remaining- else do -- rest <- readChunk fd is_stream ptr' remaining- return (so_far' + rest)--readChunk :: FD -> Bool -> Ptr a -> Int -> IO Int-readChunk fd is_stream ptr bytes0 = loop 0 bytes0- where- loop :: Int -> Int -> IO Int- loop off bytes | bytes <= 0 = return off- loop off bytes = do- r <- fromIntegral `liftM`- readRawBufferPtr "readChunk" fd is_stream - (castPtr ptr) off (fromIntegral bytes)- if r == 0- then return off- else loop (off + r) (bytes - r)----- | 'hGetBufNonBlocking' @hdl buf count@ reads data from the handle @hdl@--- into the buffer @buf@ until either EOF is reached, or--- @count@ 8-bit bytes have been read, or there is no more data available--- to read immediately.------ 'hGetBufNonBlocking' is identical to 'hGetBuf', except that it will--- never block waiting for data to become available, instead it returns--- only whatever data is available. To wait for data to arrive before--- calling 'hGetBufNonBlocking', use 'hWaitForInput'.------ If the handle is a pipe or socket, and the writing end--- is closed, 'hGetBufNonBlocking' will behave as if EOF was reached.----hGetBufNonBlocking :: Handle -> Ptr a -> Int -> IO Int-hGetBufNonBlocking h ptr count- | count == 0 = return 0- | count < 0 = illegalBufferSize h "hGetBufNonBlocking" count- | otherwise = - wantReadableHandle "hGetBufNonBlocking" h $ - \ Handle__{ haFD=fd, haBuffer=ref, haIsStream=is_stream } -> do- bufReadNonBlocking fd ref is_stream ptr 0 count--bufReadNonBlocking :: FD -> IORef Buffer -> Bool -> Ptr a -> Int -> Int- -> IO Int-bufReadNonBlocking fd ref is_stream ptr so_far count =- seq fd $ seq so_far $ seq count $ do -- strictness hack- buf@Buffer{ bufBuf=raw, bufWPtr=w, bufRPtr=r, bufSize=sz } <- readIORef ref- if bufferEmpty buf- then if count > sz -- large read?- then do rest <- readChunkNonBlocking fd is_stream ptr count- return (so_far + rest)- else do buf' <- fillReadBufferWithoutBlocking fd is_stream buf- case buf' of { Buffer{ bufWPtr=w' } ->- if (w' == 0) - then return so_far- else do writeIORef ref buf'- bufReadNonBlocking fd ref is_stream ptr- so_far (min count w')- -- NOTE: new count is min count w'- -- so we will just copy the contents of the- -- buffer in the recursive call, and not- -- loop again.- }- else do- let avail = w - r- if (count == avail)- then do - memcpy_ptr_baoff ptr raw (fromIntegral r) (fromIntegral count)- writeIORef ref buf{ bufWPtr=0, bufRPtr=0 }- return (so_far + count)- else do- if (count < avail)- then do - memcpy_ptr_baoff ptr raw (fromIntegral r) (fromIntegral count)- writeIORef ref buf{ bufRPtr = r + count }- return (so_far + count)- else do-- memcpy_ptr_baoff ptr raw (fromIntegral r) (fromIntegral avail)- writeIORef ref buf{ bufWPtr=0, bufRPtr=0 }- let remaining = count - avail- so_far' = so_far + avail- ptr' = ptr `plusPtr` avail-- -- we haven't attempted to read anything yet if we get to here.- if remaining < sz- then bufReadNonBlocking fd ref is_stream ptr' so_far' remaining- else do -- rest <- readChunkNonBlocking fd is_stream ptr' remaining- return (so_far' + rest)---readChunkNonBlocking :: FD -> Bool -> Ptr a -> Int -> IO Int-readChunkNonBlocking fd is_stream ptr bytes = do- fromIntegral `liftM`- readRawBufferPtrNoBlock "readChunkNonBlocking" fd is_stream - (castPtr ptr) 0 (fromIntegral bytes)-- -- we don't have non-blocking read support on Windows, so just invoke- -- the ordinary low-level read which will block until data is available,- -- but won't wait for the whole buffer to fill.--slurpFile :: FilePath -> IO (Ptr (), Int)-slurpFile fname = do- handle <- openFile fname ReadMode- sz <- hFileSize handle- if sz > fromIntegral (maxBound::Int) then - ioError (userError "slurpFile: file too big")- else do- let sz_i = fromIntegral sz- if sz_i == 0 then return (nullPtr, 0) else do- chunk <- mallocBytes sz_i- r <- hGetBuf handle chunk sz_i- hClose handle- return (chunk, r)---- ------------------------------------------------------------------------------ memcpy wrappers--foreign import ccall unsafe "__hscore_memcpy_src_off"- memcpy_ba_baoff :: RawBuffer -> RawBuffer -> CInt -> CSize -> IO (Ptr ())-foreign import ccall unsafe "__hscore_memcpy_src_off"- memcpy_ptr_baoff :: Ptr a -> RawBuffer -> CInt -> CSize -> IO (Ptr ())-foreign import ccall unsafe "__hscore_memcpy_dst_off"- memcpy_baoff_ba :: RawBuffer -> CInt -> RawBuffer -> CSize -> IO (Ptr ())-foreign import ccall unsafe "__hscore_memcpy_dst_off"- memcpy_baoff_ptr :: RawBuffer -> CInt -> Ptr a -> CSize -> IO (Ptr ())---------------------------------------------------------------------------------- Internal Utils--illegalBufferSize :: Handle -> String -> Int -> IO a-illegalBufferSize handle fn sz =- ioException (IOError (Just handle)- InvalidArgument fn- ("illegal buffer size " ++ showsPrec 9 sz [])- Nothing)+{-# OPTIONS_GHC -fno-warn-orphans #-}+{-# OPTIONS_GHC -XNoImplicitPrelude -funbox-strict-fields -XBangPatterns #-}+{-# OPTIONS_HADDOCK hide #-}+-----------------------------------------------------------------------------+-- |+-- Module : GHC.IO+-- Copyright : (c) The University of Glasgow 1994-2002+-- License : see libraries/base/LICENSE+-- +-- Maintainer : cvs-ghc@haskell.org+-- Stability : internal+-- Portability : non-portable (GHC Extensions)+--+-- Definitions for the 'IO' monad and its friends.+--+-----------------------------------------------------------------------------++-- #hide+module GHC.IO (+ IO(..), unIO, failIO, liftIO,+ unsafePerformIO, unsafeInterleaveIO,+ unsafeDupablePerformIO, unsafeDupableInterleaveIO,+ noDuplicate,++ -- To and from from ST+ stToIO, ioToST, unsafeIOToST, unsafeSTToIO,++ FilePath,++ catchException, catchAny, throwIO,+ block, unblock, blocked,+ onException, finally, evaluate+ ) where++import GHC.Base+import GHC.ST+import GHC.Exception+import Data.Maybe++import {-# SOURCE #-} GHC.IO.Exception ( userError )++-- ---------------------------------------------------------------------------+-- The IO Monad++{-+The IO Monad is just an instance of the ST monad, where the state is+the real world. We use the exception mechanism (in GHC.Exception) to+implement IO exceptions.++NOTE: The IO representation is deeply wired in to various parts of the+system. The following list may or may not be exhaustive:++Compiler - types of various primitives in PrimOp.lhs++RTS - forceIO (StgMiscClosures.hc)+ - catchzh_fast, (un)?blockAsyncExceptionszh_fast, raisezh_fast + (Exceptions.hc)+ - raiseAsync (Schedule.c)++Prelude - GHC.IO.lhs, and several other places including+ GHC.Exception.lhs.++Libraries - parts of hslibs/lang.++--SDM+-}++liftIO :: IO a -> State# RealWorld -> STret RealWorld a+liftIO (IO m) = \s -> case m s of (# s', r #) -> STret s' r++failIO :: String -> IO a+failIO s = IO (raiseIO# (toException (userError s)))++-- ---------------------------------------------------------------------------+-- Coercions between IO and ST++-- | A monad transformer embedding strict state transformers in the 'IO'+-- monad. The 'RealWorld' parameter indicates that the internal state+-- used by the 'ST' computation is a special one supplied by the 'IO'+-- monad, and thus distinct from those used by invocations of 'runST'.+stToIO :: ST RealWorld a -> IO a+stToIO (ST m) = IO m++ioToST :: IO a -> ST RealWorld a+ioToST (IO m) = (ST m)++-- This relies on IO and ST having the same representation modulo the+-- constraint on the type of the state+--+unsafeIOToST :: IO a -> ST s a+unsafeIOToST (IO io) = ST $ \ s -> (unsafeCoerce# io) s++unsafeSTToIO :: ST s a -> IO a+unsafeSTToIO (ST m) = IO (unsafeCoerce# m)++-- ---------------------------------------------------------------------------+-- Unsafe IO operations++{-|+This is the \"back door\" into the 'IO' monad, allowing+'IO' computation to be performed at any time. For+this to be safe, the 'IO' computation should be+free of side effects and independent of its environment.++If the I\/O computation wrapped in 'unsafePerformIO'+performs side effects, then the relative order in which those side+effects take place (relative to the main I\/O trunk, or other calls to+'unsafePerformIO') is indeterminate. You have to be careful when +writing and compiling modules that use 'unsafePerformIO':++ * Use @{\-\# NOINLINE foo \#-\}@ as a pragma on any function @foo@+ that calls 'unsafePerformIO'. If the call is inlined,+ the I\/O may be performed more than once.++ * Use the compiler flag @-fno-cse@ to prevent common sub-expression+ elimination being performed on the module, which might combine+ two side effects that were meant to be separate. A good example+ is using multiple global variables (like @test@ in the example below).++ * Make sure that the either you switch off let-floating, or that the + call to 'unsafePerformIO' cannot float outside a lambda. For example, + if you say:+ @+ f x = unsafePerformIO (newIORef [])+ @+ you may get only one reference cell shared between all calls to @f@.+ Better would be+ @+ f x = unsafePerformIO (newIORef [x])+ @+ because now it can't float outside the lambda.++It is less well known that+'unsafePerformIO' is not type safe. For example:++> test :: IORef [a]+> test = unsafePerformIO $ newIORef []+> +> main = do+> writeIORef test [42]+> bang <- readIORef test+> print (bang :: [Char])++This program will core dump. This problem with polymorphic references+is well known in the ML community, and does not arise with normal+monadic use of references. There is no easy way to make it impossible+once you use 'unsafePerformIO'. Indeed, it is+possible to write @coerce :: a -> b@ with the+help of 'unsafePerformIO'. So be careful!+-}+unsafePerformIO :: IO a -> a+unsafePerformIO m = unsafeDupablePerformIO (noDuplicate >> m)++{-| +This version of 'unsafePerformIO' is slightly more efficient,+because it omits the check that the IO is only being performed by a+single thread. Hence, when you write 'unsafeDupablePerformIO',+there is a possibility that the IO action may be performed multiple+times (on a multiprocessor), and you should therefore ensure that+it gives the same results each time.+-}+{-# NOINLINE unsafeDupablePerformIO #-}+unsafeDupablePerformIO :: IO a -> a+unsafeDupablePerformIO (IO m) = lazy (case m realWorld# of (# _, r #) -> r)++-- Why do we NOINLINE unsafeDupablePerformIO? See the comment with+-- GHC.ST.runST. Essentially the issue is that the IO computation+-- inside unsafePerformIO must be atomic: it must either all run, or+-- not at all. If we let the compiler see the application of the IO+-- to realWorld#, it might float out part of the IO.++-- Why is there a call to 'lazy' in unsafeDupablePerformIO?+-- If we don't have it, the demand analyser discovers the following strictness+-- for unsafeDupablePerformIO: C(U(AV))+-- But then consider+-- unsafeDupablePerformIO (\s -> let r = f x in +-- case writeIORef v r s of (# s1, _ #) ->+-- (# s1, r #)+-- The strictness analyser will find that the binding for r is strict,+-- (becuase of uPIO's strictness sig), and so it'll evaluate it before +-- doing the writeIORef. This actually makes tests/lib/should_run/memo002+-- get a deadlock! +--+-- Solution: don't expose the strictness of unsafeDupablePerformIO,+-- by hiding it with 'lazy'++{-|+'unsafeInterleaveIO' allows 'IO' computation to be deferred lazily.+When passed a value of type @IO a@, the 'IO' will only be performed+when the value of the @a@ is demanded. This is used to implement lazy+file reading, see 'System.IO.hGetContents'.+-}+{-# INLINE unsafeInterleaveIO #-}+unsafeInterleaveIO :: IO a -> IO a+unsafeInterleaveIO m = unsafeDupableInterleaveIO (noDuplicate >> m)++-- We believe that INLINE on unsafeInterleaveIO is safe, because the+-- state from this IO thread is passed explicitly to the interleaved+-- IO, so it cannot be floated out and shared.++{-# INLINE unsafeDupableInterleaveIO #-}+unsafeDupableInterleaveIO :: IO a -> IO a+unsafeDupableInterleaveIO (IO m)+ = IO ( \ s -> let+ r = case m s of (# _, res #) -> res+ in+ (# s, r #))++{-| +Ensures that the suspensions under evaluation by the current thread+are unique; that is, the current thread is not evaluating anything+that is also under evaluation by another thread that has also executed+'noDuplicate'.++This operation is used in the definition of 'unsafePerformIO' to+prevent the IO action from being executed multiple times, which is usually+undesirable.+-}+noDuplicate :: IO ()+noDuplicate = IO $ \s -> case noDuplicate# s of s' -> (# s', () #)++-- -----------------------------------------------------------------------------+-- | File and directory names are values of type 'String', whose precise+-- meaning is operating system dependent. Files can be opened, yielding a+-- handle which can then be used to operate on the contents of that file.++type FilePath = String++-- -----------------------------------------------------------------------------+-- Primitive catch and throwIO++{-+catchException used to handle the passing around of the state to the+action and the handler. This turned out to be a bad idea - it meant+that we had to wrap both arguments in thunks so they could be entered+as normal (remember IO returns an unboxed pair...).++Now catch# has type++ catch# :: IO a -> (b -> IO a) -> IO a++(well almost; the compiler doesn't know about the IO newtype so we+have to work around that in the definition of catchException below).+-}++catchException :: Exception e => IO a -> (e -> IO a) -> IO a+catchException (IO io) handler = IO $ catch# io handler'+ where handler' e = case fromException e of+ Just e' -> unIO (handler e')+ Nothing -> raise# e++catchAny :: IO a -> (forall e . Exception e => e -> IO a) -> IO a+catchAny (IO io) handler = IO $ catch# io handler'+ where handler' (SomeException e) = unIO (handler e)++-- | A variant of 'throw' that can only be used within the 'IO' monad.+--+-- Although 'throwIO' has a type that is an instance of the type of 'throw', the+-- two functions are subtly different:+--+-- > throw e `seq` x ===> throw e+-- > throwIO e `seq` x ===> x+--+-- The first example will cause the exception @e@ to be raised,+-- whereas the second one won\'t. In fact, 'throwIO' will only cause+-- an exception to be raised when it is used within the 'IO' monad.+-- The 'throwIO' variant should be used in preference to 'throw' to+-- raise an exception within the 'IO' monad because it guarantees+-- ordering with respect to other 'IO' operations, whereas 'throw'+-- does not.+throwIO :: Exception e => e -> IO a+throwIO e = IO (raiseIO# (toException e))++-- -----------------------------------------------------------------------------+-- Controlling asynchronous exception delivery++-- | Applying 'block' to a computation will+-- execute that computation with asynchronous exceptions+-- /blocked/. That is, any thread which+-- attempts to raise an exception in the current thread with 'Control.Exception.throwTo' will be+-- blocked until asynchronous exceptions are enabled again. There\'s+-- no need to worry about re-enabling asynchronous exceptions; that is+-- done automatically on exiting the scope of+-- 'block'.+--+-- Threads created by 'Control.Concurrent.forkIO' inherit the blocked+-- state from the parent; that is, to start a thread in blocked mode,+-- use @block $ forkIO ...@. This is particularly useful if you need to+-- establish an exception handler in the forked thread before any+-- asynchronous exceptions are received.+block :: IO a -> IO a++-- | To re-enable asynchronous exceptions inside the scope of+-- 'block', 'unblock' can be+-- used. It scopes in exactly the same way, so on exit from+-- 'unblock' asynchronous exception delivery will+-- be disabled again.+unblock :: IO a -> IO a++block (IO io) = IO $ blockAsyncExceptions# io+unblock (IO io) = IO $ unblockAsyncExceptions# io++-- | returns True if asynchronous exceptions are blocked in the+-- current thread.+blocked :: IO Bool+blocked = IO $ \s -> case asyncExceptionsBlocked# s of+ (# s', i #) -> (# s', i /=# 0# #)++onException :: IO a -> IO b -> IO a+onException io what = io `catchException` \e -> do _ <- what+ throw (e :: SomeException)++finally :: IO a -- ^ computation to run first+ -> IO b -- ^ computation to run afterward (even if an exception+ -- was raised)+ -> IO a -- returns the value from the first computation+a `finally` sequel =+ block (do+ r <- unblock a `onException` sequel+ _ <- sequel+ return r+ )++-- | Forces its argument to be evaluated to weak head normal form when+-- the resultant 'IO' action is executed. It can be used to order+-- evaluation with respect to other 'IO' operations; its semantics are+-- given by+--+-- > evaluate x `seq` y ==> y+-- > evaluate x `catch` f ==> (return $! x) `catch` f+-- > evaluate x >>= f ==> (return $! x) >>= f+--+-- /Note:/ the first equation implies that @(evaluate x)@ is /not/ the+-- same as @(return $! x)@. A correct definition is+--+-- > evaluate x = (return $! x) >>= return+--+evaluate :: a -> IO a+evaluate a = IO $ \s -> let !va = a in (# s, va #) -- NB. see #2273
+ GHC/IO.hs-boot view
@@ -0,0 +1,5 @@+module GHC.IO where++import GHC.Types++failIO :: [Char] -> IO a
+ GHC/IO/Buffer.hs view
@@ -0,0 +1,287 @@+{-# OPTIONS_GHC -XNoImplicitPrelude -funbox-strict-fields #-}+-----------------------------------------------------------------------------+-- |+-- Module : GHC.IO.Buffer+-- Copyright : (c) The University of Glasgow 2008+-- License : see libraries/base/LICENSE+-- +-- Maintainer : cvs-ghc@haskell.org+-- Stability : internal+-- Portability : non-portable (GHC Extensions)+--+-- Buffers used in the IO system+--+-----------------------------------------------------------------------------++module GHC.IO.Buffer (+ -- * Buffers of any element+ Buffer(..), BufferState(..), CharBuffer, CharBufElem,++ -- ** Creation+ newByteBuffer,+ newCharBuffer,+ newBuffer,+ emptyBuffer,++ -- ** Insertion/removal+ bufferRemove,+ bufferAdd,+ slideContents,+ bufferAdjustL,++ -- ** Inspecting+ isEmptyBuffer,+ isFullBuffer,+ isFullCharBuffer,+ isWriteBuffer,+ bufferElems,+ bufferAvailable,+ summaryBuffer,++ -- ** Operating on the raw buffer as a Ptr+ withBuffer,+ withRawBuffer,++ -- ** Assertions+ checkBuffer,++ -- * Raw buffers+ RawBuffer,+ readWord8Buf,+ writeWord8Buf,+ RawCharBuffer,+ peekCharBuf,+ readCharBuf,+ writeCharBuf,+ readCharBufPtr,+ writeCharBufPtr,+ charSize,+ ) where++import GHC.Base+-- import GHC.IO+import GHC.Num+import GHC.Ptr+import GHC.Word+import GHC.Show+import GHC.Real+import Foreign.C.Types+import Foreign.ForeignPtr+import Foreign.Storable++-- Char buffers use either UTF-16 or UTF-32, with the endianness matching+-- the endianness of the host.+--+-- Invariants:+-- * a Char buffer consists of *valid* UTF-16 or UTF-32+-- * only whole characters: no partial surrogate pairs++#define CHARBUF_UTF32++-- #define CHARBUF_UTF16+--+-- NB. it won't work to just change this to CHARBUF_UTF16. Some of+-- the code to make this work is there, and it has been tested with+-- the Iconv codec, but there are some pieces that are known to be+-- broken. In particular, the built-in codecs+-- e.g. GHC.IO.Encoding.UTF{8,16,32} need to use isFullCharBuffer or+-- similar in place of the ow >= os comparisions.++-- ---------------------------------------------------------------------------+-- Raw blocks of data++type RawBuffer e = ForeignPtr e++readWord8Buf :: RawBuffer Word8 -> Int -> IO Word8+readWord8Buf arr ix = withForeignPtr arr $ \p -> peekByteOff p ix++writeWord8Buf :: RawBuffer Word8 -> Int -> Word8 -> IO ()+writeWord8Buf arr ix w = withForeignPtr arr $ \p -> pokeByteOff p ix w++#ifdef CHARBUF_UTF16+type CharBufElem = Word16+#else+type CharBufElem = Char+#endif++type RawCharBuffer = RawBuffer CharBufElem++peekCharBuf :: RawCharBuffer -> Int -> IO Char+peekCharBuf arr ix = withForeignPtr arr $ \p -> do+ (c,_) <- readCharBufPtr p ix+ return c++{-# INLINE readCharBuf #-}+readCharBuf :: RawCharBuffer -> Int -> IO (Char, Int)+readCharBuf arr ix = withForeignPtr arr $ \p -> readCharBufPtr p ix++{-# INLINE writeCharBuf #-}+writeCharBuf :: RawCharBuffer -> Int -> Char -> IO Int+writeCharBuf arr ix c = withForeignPtr arr $ \p -> writeCharBufPtr p ix c++{-# INLINE readCharBufPtr #-}+readCharBufPtr :: Ptr CharBufElem -> Int -> IO (Char, Int)+#ifdef CHARBUF_UTF16+readCharBufPtr p ix = do+ c1 <- peekElemOff p ix+ if (c1 < 0xd800 || c1 > 0xdbff)+ then return (chr (fromIntegral c1), ix+1)+ else do c2 <- peekElemOff p (ix+1)+ return (unsafeChr ((fromIntegral c1 - 0xd800)*0x400 ++ (fromIntegral c2 - 0xdc00) + 0x10000), ix+2)+#else+readCharBufPtr p ix = do c <- peekElemOff (castPtr p) ix; return (c, ix+1)+#endif++{-# INLINE writeCharBufPtr #-}+writeCharBufPtr :: Ptr CharBufElem -> Int -> Char -> IO Int+#ifdef CHARBUF_UTF16+writeCharBufPtr p ix ch+ | c < 0x10000 = do pokeElemOff p ix (fromIntegral c)+ return (ix+1)+ | otherwise = do let c' = c - 0x10000+ pokeElemOff p ix (fromIntegral (c' `div` 0x400 + 0xd800))+ pokeElemOff p (ix+1) (fromIntegral (c' `mod` 0x400 + 0xdc00))+ return (ix+2)+ where+ c = ord ch+#else+writeCharBufPtr p ix ch = do pokeElemOff (castPtr p) ix ch; return (ix+1)+#endif++charSize :: Int+#ifdef CHARBUF_UTF16+charSize = 2+#else+charSize = 4+#endif++-- ---------------------------------------------------------------------------+-- Buffers++-- | A mutable array of bytes that can be passed to foreign functions.+--+-- The buffer is represented by a record, where the record contains+-- the raw buffer and the start/end points of the filled portion. The+-- buffer contents itself is mutable, but the rest of the record is+-- immutable. This is a slightly odd mix, but it turns out to be+-- quite practical: by making all the buffer metadata immutable, we+-- can have operations on buffer metadata outside of the IO monad.+--+-- The "live" elements of the buffer are those between the 'bufL' and+-- 'bufR' offsets. In an empty buffer, 'bufL' is equal to 'bufR', but+-- they might not be zero: for exmaple, the buffer might correspond to+-- a memory-mapped file and in which case 'bufL' will point to the+-- next location to be written, which is not necessarily the beginning+-- of the file.+data Buffer e+ = Buffer {+ bufRaw :: !(RawBuffer e),+ bufState :: BufferState,+ bufSize :: !Int, -- in elements, not bytes+ bufL :: !Int, -- offset of first item in the buffer+ bufR :: !Int -- offset of last item + 1+ }++#ifdef CHARBUF_UTF16+type CharBuffer = Buffer Word16+#else+type CharBuffer = Buffer Char+#endif++data BufferState = ReadBuffer | WriteBuffer deriving (Eq)++withBuffer :: Buffer e -> (Ptr e -> IO a) -> IO a+withBuffer Buffer{ bufRaw=raw } f = withForeignPtr (castForeignPtr raw) f++withRawBuffer :: RawBuffer e -> (Ptr e -> IO a) -> IO a+withRawBuffer raw f = withForeignPtr (castForeignPtr raw) f++isEmptyBuffer :: Buffer e -> Bool+isEmptyBuffer Buffer{ bufL=l, bufR=r } = l == r++isFullBuffer :: Buffer e -> Bool+isFullBuffer Buffer{ bufR=w, bufSize=s } = s == w++-- if a Char buffer does not have room for a surrogate pair, it is "full"+isFullCharBuffer :: Buffer e -> Bool+#ifdef CHARBUF_UTF16+isFullCharBuffer buf = bufferAvailable buf < 2+#else+isFullCharBuffer = isFullBuffer+#endif++isWriteBuffer :: Buffer e -> Bool+isWriteBuffer buf = case bufState buf of+ WriteBuffer -> True+ ReadBuffer -> False++bufferElems :: Buffer e -> Int+bufferElems Buffer{ bufR=w, bufL=r } = w - r++bufferAvailable :: Buffer e -> Int+bufferAvailable Buffer{ bufR=w, bufSize=s } = s - w++bufferRemove :: Int -> Buffer e -> Buffer e+bufferRemove i buf@Buffer{ bufL=r } = bufferAdjustL (r+i) buf++bufferAdjustL :: Int -> Buffer e -> Buffer e+bufferAdjustL l buf@Buffer{ bufR=w }+ | l == w = buf{ bufL=0, bufR=0 }+ | otherwise = buf{ bufL=l, bufR=w }++bufferAdd :: Int -> Buffer e -> Buffer e+bufferAdd i buf@Buffer{ bufR=w } = buf{ bufR=w+i }++emptyBuffer :: RawBuffer e -> Int -> BufferState -> Buffer e+emptyBuffer raw sz state = + Buffer{ bufRaw=raw, bufState=state, bufR=0, bufL=0, bufSize=sz }++newByteBuffer :: Int -> BufferState -> IO (Buffer Word8)+newByteBuffer c st = newBuffer c c st++newCharBuffer :: Int -> BufferState -> IO CharBuffer+newCharBuffer c st = newBuffer (c * charSize) c st++newBuffer :: Int -> Int -> BufferState -> IO (Buffer e)+newBuffer bytes sz state = do+ fp <- mallocForeignPtrBytes bytes+ return (emptyBuffer fp sz state)++-- | slides the contents of the buffer to the beginning+slideContents :: Buffer Word8 -> IO (Buffer Word8)+slideContents buf@Buffer{ bufL=l, bufR=r, bufRaw=raw } = do+ let elems = r - l+ withRawBuffer raw $ \p ->+ do _ <- memcpy p (p `plusPtr` l) (fromIntegral elems)+ return ()+ return buf{ bufL=0, bufR=elems }++foreign import ccall unsafe "memcpy"+ memcpy :: Ptr a -> Ptr a -> CSize -> IO (Ptr ())++summaryBuffer :: Buffer a -> String+summaryBuffer buf = "buf" ++ show (bufSize buf) ++ "(" ++ show (bufL buf) ++ "-" ++ show (bufR buf) ++ ")"++-- INVARIANTS on Buffers:+-- * r <= w+-- * if r == w, and the buffer is for reading, then r == 0 && w == 0+-- * a write buffer is never full. If an operation+-- fills up the buffer, it will always flush it before +-- returning.+-- * a read buffer may be full as a result of hLookAhead. In normal+-- operation, a read buffer always has at least one character of space.++checkBuffer :: Buffer a -> IO ()+checkBuffer buf@Buffer{ bufState = state, bufL=r, bufR=w, bufSize=size } = do+ check buf (+ size > 0+ && r <= w+ && w <= size+ && ( r /= w || state == WriteBuffer || (r == 0 && w == 0) )+ && ( state /= WriteBuffer || w < size ) -- write buffer is never full+ )++check :: Buffer a -> Bool -> IO ()+check _ True = return ()+check buf False = error ("buffer invariant violation: " ++ summaryBuffer buf)
+ GHC/IO/BufferedIO.hs view
@@ -0,0 +1,127 @@+{-# OPTIONS_GHC -XNoImplicitPrelude -funbox-strict-fields #-}+-----------------------------------------------------------------------------+-- |+-- Module : GHC.IO.BufferedIO+-- Copyright : (c) The University of Glasgow 2008+-- License : see libraries/base/LICENSE+-- +-- Maintainer : cvs-ghc@haskell.org+-- Stability : internal+-- Portability : non-portable (GHC Extensions)+--+-- Class of buffered IO devices+--+-----------------------------------------------------------------------------++module GHC.IO.BufferedIO (+ BufferedIO(..),+ readBuf, readBufNonBlocking, writeBuf, writeBufNonBlocking+ ) where++import GHC.Base+import GHC.Ptr+import Data.Word+import GHC.Num+import GHC.Real+import Data.Maybe+-- import GHC.IO+import GHC.IO.Device as IODevice+import GHC.IO.Device as RawIO+import GHC.IO.Buffer++-- | The purpose of 'BufferedIO' is to provide a common interface for I/O+-- devices that can read and write data through a buffer. Devices that+-- implement 'BufferedIO' include ordinary files, memory-mapped files,+-- and bytestrings. The underlying device implementing a 'Handle' must+-- provide 'BufferedIO'.+--+class BufferedIO dev where+ -- | allocate a new buffer. The size of the buffer is at the+ -- discretion of the device; e.g. for a memory-mapped file the+ -- buffer will probably cover the entire file.+ newBuffer :: dev -> BufferState -> IO (Buffer Word8)++ -- | reads bytes into the buffer, blocking if there are no bytes+ -- available. Returns the number of bytes read (zero indicates+ -- end-of-file), and the new buffer.+ fillReadBuffer :: dev -> Buffer Word8 -> IO (Int, Buffer Word8)++ -- | reads bytes into the buffer without blocking. Returns the+ -- number of bytes read (Nothing indicates end-of-file), and the new+ -- buffer.+ fillReadBuffer0 :: dev -> Buffer Word8 -> IO (Maybe Int, Buffer Word8)++ -- | Prepares an empty write buffer. This lets the device decide+ -- how to set up a write buffer: the buffer may need to point to a+ -- specific location in memory, for example. This is typically used+ -- by the client when switching from reading to writing on a+ -- buffered read/write device.+ --+ -- There is no corresponding operation for read buffers, because before+ -- reading the client will always call 'fillReadBuffer'.+ emptyWriteBuffer :: dev -> Buffer Word8 -> IO (Buffer Word8)+ emptyWriteBuffer _dev buf + = return buf{ bufL=0, bufR=0, bufState = WriteBuffer }++ -- | Flush all the data from the supplied write buffer out to the device.+ -- The returned buffer should be empty, and ready for writing.+ flushWriteBuffer :: dev -> Buffer Word8 -> IO (Buffer Word8)++ -- | Flush data from the supplied write buffer out to the device+ -- without blocking. Returns the number of bytes written and the+ -- remaining buffer.+ flushWriteBuffer0 :: dev -> Buffer Word8 -> IO (Int, Buffer Word8)++-- for an I/O device, these operations will perform reading/writing+-- to/from the device.++-- for a memory-mapped file, the buffer will be the whole file in+-- memory. fillReadBuffer sets the pointers to encompass the whole+-- file, and flushWriteBuffer needs to do no I/O. A memory-mapped+-- file has to maintain its own file pointer.++-- for a bytestring, again the buffer should match the bytestring in+-- memory.++-- ---------------------------------------------------------------------------+-- Low-level read/write to/from buffers++-- These operations make it easy to implement an instance of 'BufferedIO'+-- for an object that supports 'RawIO'.++readBuf :: RawIO dev => dev -> Buffer Word8 -> IO (Int, Buffer Word8)+readBuf dev bbuf = do+ let bytes = bufferAvailable bbuf+ res <- withBuffer bbuf $ \ptr ->+ RawIO.read dev (ptr `plusPtr` bufR bbuf) (fromIntegral bytes)+ let res' = fromIntegral res+ return (res', bbuf{ bufR = bufR bbuf + res' })+ -- zero indicates end of file++readBufNonBlocking :: RawIO dev => dev -> Buffer Word8+ -> IO (Maybe Int, -- Nothing ==> end of file+ -- Just n ==> n bytes were read (n>=0)+ Buffer Word8)+readBufNonBlocking dev bbuf = do+ let bytes = bufferAvailable bbuf+ res <- withBuffer bbuf $ \ptr ->+ IODevice.readNonBlocking dev (ptr `plusPtr` bufR bbuf) (fromIntegral bytes)+ case res of+ Nothing -> return (Nothing, bbuf)+ Just n -> return (Just n, bbuf{ bufR = bufR bbuf + fromIntegral n })++writeBuf :: RawIO dev => dev -> Buffer Word8 -> IO (Buffer Word8)+writeBuf dev bbuf = do+ let bytes = bufferElems bbuf+ withBuffer bbuf $ \ptr ->+ IODevice.write dev (ptr `plusPtr` bufL bbuf) (fromIntegral bytes)+ return bbuf{ bufL=0, bufR=0 }++-- XXX ToDo+writeBufNonBlocking :: RawIO dev => dev -> Buffer Word8 -> IO (Int, Buffer Word8)+writeBufNonBlocking dev bbuf = do+ let bytes = bufferElems bbuf+ res <- withBuffer bbuf $ \ptr ->+ IODevice.writeNonBlocking dev (ptr `plusPtr` bufL bbuf)+ (fromIntegral bytes)+ return (res, bufferAdjustL res bbuf)
+ GHC/IO/Device.hs view
@@ -0,0 +1,152 @@+{-# OPTIONS_GHC -XNoImplicitPrelude -XBangPatterns #-}+-----------------------------------------------------------------------------+-- |+-- Module : GHC.IO.Device+-- Copyright : (c) The University of Glasgow, 1994-2008+-- License : see libraries/base/LICENSE+-- +-- Maintainer : libraries@haskell.org+-- Stability : internal+-- Portability : non-portable+--+-- Type classes for I/O providers.+--+-----------------------------------------------------------------------------++module GHC.IO.Device (+ RawIO(..),+ IODevice(..),+ IODeviceType(..),+ SeekMode(..)+ ) where ++#ifdef __GLASGOW_HASKELL__+import GHC.Base+import GHC.Word+import GHC.Arr+import GHC.Enum+import GHC.Read+import GHC.Show+import GHC.Ptr+import Data.Maybe+import GHC.Num+import GHC.IO+import {-# SOURCE #-} GHC.IO.Exception ( unsupportedOperation )+#endif+#ifdef __NHC__+import Foreign+import Ix+import Control.Exception.Base+unsupportedOperation = userError "unsupported operation"+#endif++-- | A low-level I/O provider where the data is bytes in memory.+class RawIO a where+ -- | Read up to the specified number of bytes, returning the number+ -- of bytes actually read. This function should only block if there+ -- is no data available. If there is not enough data available,+ -- then the function should just return the available data. A return+ -- value of zero indicates that the end of the data stream (e.g. end+ -- of file) has been reached.+ read :: a -> Ptr Word8 -> Int -> IO Int++ -- | Read up to the specified number of bytes, returning the number+ -- of bytes actually read, or 'Nothing' if the end of the stream has+ -- been reached.+ readNonBlocking :: a -> Ptr Word8 -> Int -> IO (Maybe Int)++ -- | Write the specified number of bytes.+ write :: a -> Ptr Word8 -> Int -> IO ()++ -- | Write up to the specified number of bytes without blocking. Returns+ -- the actual number of bytes written.+ writeNonBlocking :: a -> Ptr Word8 -> Int -> IO Int+++-- | I/O operations required for implementing a 'Handle'.+class IODevice a where+ -- | @ready dev write msecs@ returns 'True' if the device has data+ -- to read (if @write@ is 'False') or space to write new data (if+ -- @write@ is 'True'). @msecs@ specifies how long to wait, in+ -- milliseconds.+ -- + ready :: a -> Bool -> Int -> IO Bool++ -- | closes the device. Further operations on the device should+ -- produce exceptions.+ close :: a -> IO ()++ -- | returns 'True' if the device is a terminal or console.+ isTerminal :: a -> IO Bool+ isTerminal _ = return False++ -- | returns 'True' if the device supports 'seek' operations.+ isSeekable :: a -> IO Bool+ isSeekable _ = return False++ -- | seek to the specified position in the data.+ seek :: a -> SeekMode -> Integer -> IO ()+ seek _ _ _ = ioe_unsupportedOperation++ -- | return the current position in the data.+ tell :: a -> IO Integer+ tell _ = ioe_unsupportedOperation++ -- | return the size of the data.+ getSize :: a -> IO Integer+ getSize _ = ioe_unsupportedOperation++ -- | change the size of the data.+ setSize :: a -> Integer -> IO () + setSize _ _ = ioe_unsupportedOperation++ -- | for terminal devices, changes whether characters are echoed on+ -- the device.+ setEcho :: a -> Bool -> IO ()+ setEcho _ _ = ioe_unsupportedOperation++ -- | returns the current echoing status.+ getEcho :: a -> IO Bool+ getEcho _ = ioe_unsupportedOperation++ -- | some devices (e.g. terminals) support a "raw" mode where+ -- characters entered are immediately made available to the program.+ -- If available, this operations enables raw mode.+ setRaw :: a -> Bool -> IO ()+ setRaw _ _ = ioe_unsupportedOperation++ -- | returns the 'IODeviceType' corresponding to this device.+ devType :: a -> IO IODeviceType++ -- | duplicates the device, if possible. The new device is expected+ -- to share a file pointer with the original device (like Unix @dup@).+ dup :: a -> IO a+ dup _ = ioe_unsupportedOperation++ -- | @dup2 source target@ replaces the target device with the source+ -- device. The target device is closed first, if necessary, and then+ -- it is made into a duplicate of the first device (like Unix @dup2@).+ dup2 :: a -> a -> IO a+ dup2 _ _ = ioe_unsupportedOperation++ioe_unsupportedOperation :: IO a+ioe_unsupportedOperation = throwIO unsupportedOperation++data IODeviceType+ = Directory+ | Stream+ | RegularFile+ | RawDevice+ deriving (Eq)++-- -----------------------------------------------------------------------------+-- SeekMode type++-- | A mode that determines the effect of 'hSeek' @hdl mode i@, as follows:+data SeekMode+ = AbsoluteSeek -- ^ the position of @hdl@ is set to @i@.+ | RelativeSeek -- ^ the position of @hdl@ is set to offset @i@+ -- from the current position.+ | SeekFromEnd -- ^ the position of @hdl@ is set to offset @i@+ -- from the end of the file.+ deriving (Eq, Ord, Ix, Enum, Read, Show)
+ GHC/IO/Encoding.hs view
@@ -0,0 +1,155 @@+{-# OPTIONS_GHC -XNoImplicitPrelude -funbox-strict-fields #-}+-----------------------------------------------------------------------------+-- |+-- Module : GHC.IO.Encoding+-- Copyright : (c) The University of Glasgow, 2008-2009+-- License : see libraries/base/LICENSE+-- +-- Maintainer : libraries@haskell.org+-- Stability : internal+-- Portability : non-portable+--+-- Text codecs for I/O+--+-----------------------------------------------------------------------------++module GHC.IO.Encoding (+ BufferCodec(..), TextEncoding(..), TextEncoder, TextDecoder,+ latin1, latin1_encode, latin1_decode,+ utf8, utf8_bom,+ utf16, utf16le, utf16be,+ utf32, utf32le, utf32be, + localeEncoding,+ mkTextEncoding,+ ) where++import GHC.Base+--import GHC.IO+import GHC.IO.Buffer+import GHC.IO.Encoding.Types+import GHC.Word+#if !defined(mingw32_HOST_OS)+import qualified GHC.IO.Encoding.Iconv as Iconv+#else+import qualified GHC.IO.Encoding.CodePage as CodePage+import Text.Read (reads)+#endif+import qualified GHC.IO.Encoding.Latin1 as Latin1+import qualified GHC.IO.Encoding.UTF8 as UTF8+import qualified GHC.IO.Encoding.UTF16 as UTF16+import qualified GHC.IO.Encoding.UTF32 as UTF32++#if defined(mingw32_HOST_OS)+import Data.Maybe+import GHC.IO.Exception+#endif++-- -----------------------------------------------------------------------------++-- | The Latin1 (ISO8859-1) encoding. This encoding maps bytes+-- directly to the first 256 Unicode code points, and is thus not a+-- complete Unicode encoding. An attempt to write a character greater than+-- '\255' to a 'Handle' using the 'latin1' encoding will result in an error.+latin1 :: TextEncoding+latin1 = Latin1.latin1_checked++-- | The UTF-8 Unicode encoding+utf8 :: TextEncoding+utf8 = UTF8.utf8++-- | The UTF-8 Unicode encoding, with a byte-order-mark (BOM; the byte+-- sequence 0xEF 0xBB 0xBF). This encoding behaves like 'utf8',+-- except that on input, the BOM sequence is ignored at the beginning+-- of the stream, and on output, the BOM sequence is prepended.+--+-- The byte-order-mark is strictly unnecessary in UTF-8, but is+-- sometimes used to identify the encoding of a file.+--+utf8_bom :: TextEncoding+utf8_bom = UTF8.utf8_bom++-- | The UTF-16 Unicode encoding (a byte-order-mark should be used to+-- indicate endianness).+utf16 :: TextEncoding+utf16 = UTF16.utf16++-- | The UTF-16 Unicode encoding (litte-endian)+utf16le :: TextEncoding+utf16le = UTF16.utf16le++-- | The UTF-16 Unicode encoding (big-endian)+utf16be :: TextEncoding+utf16be = UTF16.utf16be++-- | The UTF-32 Unicode encoding (a byte-order-mark should be used to+-- indicate endianness).+utf32 :: TextEncoding+utf32 = UTF32.utf32++-- | The UTF-32 Unicode encoding (litte-endian)+utf32le :: TextEncoding+utf32le = UTF32.utf32le++-- | The UTF-32 Unicode encoding (big-endian)+utf32be :: TextEncoding+utf32be = UTF32.utf32be++-- | The Unicode encoding of the current locale+localeEncoding :: TextEncoding+#if !defined(mingw32_HOST_OS)+localeEncoding = Iconv.localeEncoding+#else+localeEncoding = CodePage.localeEncoding+#endif++-- | Look up the named Unicode encoding. May fail with +--+-- * 'isDoesNotExistError' if the encoding is unknown+--+-- The set of known encodings is system-dependent, but includes at least:+--+-- * @UTF-8@+--+-- * @UTF-16@, @UTF-16BE@, @UTF-16LE@+--+-- * @UTF-32@, @UTF-32BE@, @UTF-32LE@+--+-- On systems using GNU iconv (e.g. Linux), there is additional+-- notation for specifying how illegal characters are handled:+--+-- * a suffix of @\/\/IGNORE@, e.g. @UTF-8\/\/IGNORE@, will cause +-- all illegal sequences on input to be ignored, and on output+-- will drop all code points that have no representation in the+-- target encoding.+--+-- * a suffix of @\/\/TRANSLIT@ will choose a replacement character+-- for illegal sequences or code points.+--+-- On Windows, you can access supported code pages with the prefix+-- @CP@; for example, @\"CP1250\"@.+--+mkTextEncoding :: String -> IO TextEncoding+#if !defined(mingw32_HOST_OS)+mkTextEncoding = Iconv.mkTextEncoding+#else+mkTextEncoding "UTF-8" = return utf8+mkTextEncoding "UTF-16" = return utf16+mkTextEncoding "UTF-16LE" = return utf16le+mkTextEncoding "UTF-16BE" = return utf16be+mkTextEncoding "UTF-32" = return utf32+mkTextEncoding "UTF-32LE" = return utf32le+mkTextEncoding "UTF-32BE" = return utf32be+mkTextEncoding ('C':'P':n)+ | [(cp,"")] <- reads n = return $ CodePage.codePageEncoding cp+mkTextEncoding e = ioException+ (IOError Nothing NoSuchThing "mkTextEncoding"+ ("unknown encoding:" ++ e) Nothing Nothing)+#endif++latin1_encode :: CharBuffer -> Buffer Word8 -> IO (CharBuffer, Buffer Word8)+latin1_encode = Latin1.latin1_encode -- unchecked, used for binary+--latin1_encode = unsafePerformIO $ do mkTextEncoder Iconv.latin1 >>= return.encode++latin1_decode :: Buffer Word8 -> CharBuffer -> IO (Buffer Word8, CharBuffer)+latin1_decode = Latin1.latin1_decode+--latin1_decode = unsafePerformIO $ do mkTextDecoder Iconv.latin1 >>= return.encode
+ GHC/IO/Encoding/CodePage.hs view
@@ -0,0 +1,158 @@+{-# LANGUAGE BangPatterns #-}+module GHC.IO.Encoding.CodePage(+#if !defined(mingw32_HOST_OS)+ ) where+#else+ codePageEncoding,+ localeEncoding+ ) where++import GHC.Base+import GHC.Num+import GHC.Enum+import GHC.Word+import GHC.IO (unsafePerformIO)+import GHC.IO.Encoding.Types+import GHC.IO.Buffer+import GHC.IO.Exception+import Data.Bits+import Data.Maybe+import Data.List (lookup)++import GHC.IO.Encoding.CodePage.Table++import GHC.IO.Encoding.Latin1 (latin1)+import GHC.IO.Encoding.UTF8 (utf8)+import GHC.IO.Encoding.UTF16 (utf16le, utf16be)+import GHC.IO.Encoding.UTF32 (utf32le, utf32be)++-- note CodePage = UInt which might not work on Win64. But the Win32 package+-- also has this issue.+getCurrentCodePage :: IO Word32+getCurrentCodePage = do+ conCP <- getConsoleCP+ if conCP > 0+ then return conCP+ else getACP++-- Since the Win32 package depends on base, we have to import these ourselves:+foreign import stdcall unsafe "windows.h GetConsoleCP"+ getConsoleCP :: IO Word32++foreign import stdcall unsafe "windows.h GetACP"+ getACP :: IO Word32++{-# NOINLINE localeEncoding #-}+localeEncoding :: TextEncoding+localeEncoding = unsafePerformIO $ fmap codePageEncoding getCurrentCodePage+ ++codePageEncoding :: Word32 -> TextEncoding+codePageEncoding 65001 = utf8+codePageEncoding 1200 = utf16le+codePageEncoding 1201 = utf16be+codePageEncoding 12000 = utf32le+codePageEncoding 12001 = utf32be+codePageEncoding cp = maybe latin1 buildEncoding (lookup cp codePageMap)++buildEncoding :: CodePageArrays -> TextEncoding+buildEncoding SingleByteCP {decoderArray = dec, encoderArray = enc}+ = TextEncoding {+ mkTextDecoder = return $ simpleCodec+ $ decodeFromSingleByte dec+ , mkTextEncoder = return $ simpleCodec $ encodeToSingleByte enc+ }++simpleCodec :: (Buffer from -> Buffer to -> IO (Buffer from, Buffer to))+ -> BufferCodec from to ()+simpleCodec f = BufferCodec {encode = f, close = return (), getState = return (),+ setState = return }++decodeFromSingleByte :: ConvArray Char -> DecodeBuffer+decodeFromSingleByte convArr+ input@Buffer { bufRaw=iraw, bufL=ir0, bufR=iw, bufSize=_ }+ output@Buffer { bufRaw=oraw, bufL=_, bufR=ow0, bufSize=os }+ = let+ done !ir !ow = return (if ir==iw then input{ bufL=0, bufR=0}+ else input{ bufL=ir},+ output {bufR=ow})+ loop !ir !ow+ | ow >= os || ir >= iw = done ir ow+ | otherwise = do+ b <- readWord8Buf iraw ir+ let c = lookupConv convArr b+ if c=='\0' && b /= 0 then invalid else do+ ow' <- writeCharBuf oraw ow c+ loop (ir+1) ow'+ where+ invalid = if ir > ir0 then done ir ow else ioe_decodingError+ in loop ir0 ow0++encodeToSingleByte :: CompactArray Char Word8 -> EncodeBuffer+encodeToSingleByte CompactArray { encoderMax = maxChar,+ encoderIndices = indices,+ encoderValues = values }+ input@Buffer{ bufRaw=iraw, bufL=ir0, bufR=iw, bufSize=_ }+ output@Buffer{ bufRaw=oraw, bufL=_, bufR=ow0, bufSize=os }+ = let+ done !ir !ow = return (if ir==iw then input { bufL=0, bufR=0 }+ else input { bufL=ir },+ output {bufR=ow})+ loop !ir !ow+ | ow >= os || ir >= iw = done ir ow+ | otherwise = do+ (c,ir') <- readCharBuf iraw ir+ case lookupCompact maxChar indices values c of+ Nothing -> invalid+ Just 0 | c /= '\0' -> invalid+ Just b -> do+ writeWord8Buf oraw ow b+ loop ir' (ow+1)+ where+ invalid = if ir > ir0 then done ir ow else ioe_encodingError+ in+ loop ir0 ow0++ioe_decodingError :: IO a+ioe_decodingError = ioException+ (IOError Nothing InvalidArgument "codePageEncoding"+ "invalid code page byte sequence" Nothing Nothing)++ioe_encodingError :: IO a+ioe_encodingError = ioException+ (IOError Nothing InvalidArgument "codePageEncoding"+ "character is not in the code page" Nothing Nothing)+++--------------------------------------------+-- Array access functions++-- {-# INLINE lookupConv #-}+lookupConv :: ConvArray Char -> Word8 -> Char+lookupConv a = indexChar a . fromEnum++{-# INLINE lookupCompact #-}+lookupCompact :: Char -> ConvArray Int -> ConvArray Word8 -> Char -> Maybe Word8+lookupCompact maxVal indexes values x+ | x > maxVal = Nothing+ | otherwise = Just $ indexWord8 values $ j + (i .&. mask)+ where+ i = fromEnum x+ mask = (1 `shiftL` n) - 1+ k = i `shiftR` n+ j = indexInt indexes k+ n = blockBitSize++{-# INLINE indexInt #-}+indexInt :: ConvArray Int -> Int -> Int+indexInt (ConvArray p) (I# i) = I# (indexInt16OffAddr# p i)++{-# INLINE indexWord8 #-}+indexWord8 :: ConvArray Word8 -> Int -> Word8+indexWord8 (ConvArray p) (I# i) = W8# (indexWord8OffAddr# p i)++{-# INLINE indexChar #-}+indexChar :: ConvArray Char -> Int -> Char+indexChar (ConvArray p) (I# i) = C# (chr# (indexInt16OffAddr# p i))++#endif
+ GHC/IO/Encoding/CodePage/Table.hs view
@@ -0,0 +1,430 @@+{-# LANGUAGE MagicHash #-}+-- Do not edit this file directly!+-- It was generated by the MakeTable.hs script using the following files:+-- CP037.TXT+-- CP1026.TXT+-- CP1250.TXT+-- CP1251.TXT+-- CP1252.TXT+-- CP1253.TXT+-- CP1254.TXT+-- CP1255.TXT+-- CP1256.TXT+-- CP1257.TXT+-- CP1258.TXT+-- CP437.TXT+-- CP500.TXT+-- CP737.TXT+-- CP775.TXT+-- CP850.TXT+-- CP852.TXT+-- CP855.TXT+-- CP857.TXT+-- CP860.TXT+-- CP861.TXT+-- CP862.TXT+-- CP863.TXT+-- CP864.TXT+-- CP865.TXT+-- CP866.TXT+-- CP869.TXT+-- CP874.TXT+-- CP875.TXT+module GHC.IO.Encoding.CodePage.Table where++import GHC.Prim+import GHC.Base+import GHC.Word+import GHC.Num+data ConvArray a = ConvArray Addr#+data CompactArray a b = CompactArray {+ encoderMax :: !a,+ encoderIndices :: !(ConvArray Int),+ encoderValues :: !(ConvArray b)+ }++data CodePageArrays = SingleByteCP {+ decoderArray :: !(ConvArray Char),+ encoderArray :: !(CompactArray Char Word8)+ }++blockBitSize :: Int+blockBitSize = 6+codePageMap :: [(Word32, CodePageArrays)]+codePageMap = [+ (37, SingleByteCP {+ decoderArray = ConvArray "\x0\x0\x1\x0\x2\x0\x3\x0\x9c\x0\x9\x0\x86\x0\x7f\x0\x97\x0\x8d\x0\x8e\x0\xb\x0\xc\x0\xd\x0\xe\x0\xf\x0\x10\x0\x11\x0\x12\x0\x13\x0\x9d\x0\x85\x0\x8\x0\x87\x0\x18\x0\x19\x0\x92\x0\x8f\x0\x1c\x0\x1d\x0\x1e\x0\x1f\x0\x80\x0\x81\x0\x82\x0\x83\x0\x84\x0\xa\x0\x17\x0\x1b\x0\x88\x0\x89\x0\x8a\x0\x8b\x0\x8c\x0\x5\x0\x6\x0\x7\x0\x90\x0\x91\x0\x16\x0\x93\x0\x94\x0\x95\x0\x96\x0\x4\x0\x98\x0\x99\x0\x9a\x0\x9b\x0\x14\x0\x15\x0\x9e\x0\x1a\x0\x20\x0\xa0\x0\xe2\x0\xe4\x0\xe0\x0\xe1\x0\xe3\x0\xe5\x0\xe7\x0\xf1\x0\xa2\x0\x2e\x0\x3c\x0\x28\x0\x2b\x0\x7c\x0\x26\x0\xe9\x0\xea\x0\xeb\x0\xe8\x0\xed\x0\xee\x0\xef\x0\xec\x0\xdf\x0\x21\x0\x24\x0\x2a\x0\x29\x0\x3b\x0\xac\x0\x2d\x0\x2f\x0\xc2\x0\xc4\x0\xc0\x0\xc1\x0\xc3\x0\xc5\x0\xc7\x0\xd1\x0\xa6\x0\x2c\x0\x25\x0\x5f\x0\x3e\x0\x3f\x0\xf8\x0\xc9\x0\xca\x0\xcb\x0\xc8\x0\xcd\x0\xce\x0\xcf\x0\xcc\x0\x60\x0\x3a\x0\x23\x0\x40\x0\x27\x0\x3d\x0\x22\x0\xd8\x0\x61\x0\x62\x0\x63\x0\x64\x0\x65\x0\x66\x0\x67\x0\x68\x0\x69\x0\xab\x0\xbb\x0\xf0\x0\xfd\x0\xfe\x0\xb1\x0\xb0\x0\x6a\x0\x6b\x0\x6c\x0\x6d\x0\x6e\x0\x6f\x0\x70\x0\x71\x0\x72\x0\xaa\x0\xba\x0\xe6\x0\xb8\x0\xc6\x0\xa4\x0\xb5\x0\x7e\x0\x73\x0\x74\x0\x75\x0\x76\x0\x77\x0\x78\x0\x79\x0\x7a\x0\xa1\x0\xbf\x0\xd0\x0\xdd\x0\xde\x0\xae\x0\x5e\x0\xa3\x0\xa5\x0\xb7\x0\xa9\x0\xa7\x0\xb6\x0\xbc\x0\xbd\x0\xbe\x0\x5b\x0\x5d\x0\xaf\x0\xa8\x0\xb4\x0\xd7\x0\x7b\x0\x41\x0\x42\x0\x43\x0\x44\x0\x45\x0\x46\x0\x47\x0\x48\x0\x49\x0\xad\x0\xf4\x0\xf6\x0\xf2\x0\xf3\x0\xf5\x0\x7d\x0\x4a\x0\x4b\x0\x4c\x0\x4d\x0\x4e\x0\x4f\x0\x50\x0\x51\x0\x52\x0\xb9\x0\xfb\x0\xfc\x0\xf9\x0\xfa\x0\xff\x0\x5c\x0\xf7\x0\x53\x0\x54\x0\x55\x0\x56\x0\x57\x0\x58\x0\x59\x0\x5a\x0\xb2\x0\xd4\x0\xd6\x0\xd2\x0\xd3\x0\xd5\x0\x30\x0\x31\x0\x32\x0\x33\x0\x34\x0\x35\x0\x36\x0\x37\x0\x38\x0\x39\x0\xb3\x0\xdb\x0\xdc\x0\xd9\x0\xda\x0\x9f\x0"#+ , encoderArray = + CompactArray {+ encoderIndices = ConvArray "\x0\x0\x40\x0\x80\x0\xc0\x0"#+ , encoderValues = ConvArray "\x0\x1\x2\x3\x37\x2d\x2e\x2f\x16\x5\x25\xb\xc\xd\xe\xf\x10\x11\x12\x13\x3c\x3d\x32\x26\x18\x19\x3f\x27\x1c\x1d\x1e\x1f\x40\x5a\x7f\x7b\x5b\x6c\x50\x7d\x4d\x5d\x5c\x4e\x6b\x60\x4b\x61\xf0\xf1\xf2\xf3\xf4\xf5\xf6\xf7\xf8\xf9\x7a\x5e\x4c\x7e\x6e\x6f\x7c\xc1\xc2\xc3\xc4\xc5\xc6\xc7\xc8\xc9\xd1\xd2\xd3\xd4\xd5\xd6\xd7\xd8\xd9\xe2\xe3\xe4\xe5\xe6\xe7\xe8\xe9\xba\xe0\xbb\xb0\x6d\x79\x81\x82\x83\x84\x85\x86\x87\x88\x89\x91\x92\x93\x94\x95\x96\x97\x98\x99\xa2\xa3\xa4\xa5\xa6\xa7\xa8\xa9\xc0\x4f\xd0\xa1\x7\x20\x21\x22\x23\x24\x15\x6\x17\x28\x29\x2a\x2b\x2c\x9\xa\x1b\x30\x31\x1a\x33\x34\x35\x36\x8\x38\x39\x3a\x3b\x4\x14\x3e\xff\x41\xaa\x4a\xb1\x9f\xb2\x6a\xb5\xbd\xb4\x9a\x8a\x5f\xca\xaf\xbc\x90\x8f\xea\xfa\xbe\xa0\xb6\xb3\x9d\xda\x9b\x8b\xb7\xb8\xb9\xab\x64\x65\x62\x66\x63\x67\x9e\x68\x74\x71\x72\x73\x78\x75\x76\x77\xac\x69\xed\xee\xeb\xef\xec\xbf\x80\xfd\xfe\xfb\xfc\xad\xae\x59\x44\x45\x42\x46\x43\x47\x9c\x48\x54\x51\x52\x53\x58\x55\x56\x57\x8c\x49\xcd\xce\xcb\xcf\xcc\xe1\x70\xdd\xde\xdb\xdc\x8d\x8e\xdf"#+ , encoderMax = '\255'+ }++ }+ )++ ,+ (1026, SingleByteCP {+ decoderArray = ConvArray "\x0\x0\x1\x0\x2\x0\x3\x0\x9c\x0\x9\x0\x86\x0\x7f\x0\x97\x0\x8d\x0\x8e\x0\xb\x0\xc\x0\xd\x0\xe\x0\xf\x0\x10\x0\x11\x0\x12\x0\x13\x0\x9d\x0\x85\x0\x8\x0\x87\x0\x18\x0\x19\x0\x92\x0\x8f\x0\x1c\x0\x1d\x0\x1e\x0\x1f\x0\x80\x0\x81\x0\x82\x0\x83\x0\x84\x0\xa\x0\x17\x0\x1b\x0\x88\x0\x89\x0\x8a\x0\x8b\x0\x8c\x0\x5\x0\x6\x0\x7\x0\x90\x0\x91\x0\x16\x0\x93\x0\x94\x0\x95\x0\x96\x0\x4\x0\x98\x0\x99\x0\x9a\x0\x9b\x0\x14\x0\x15\x0\x9e\x0\x1a\x0\x20\x0\xa0\x0\xe2\x0\xe4\x0\xe0\x0\xe1\x0\xe3\x0\xe5\x0\x7b\x0\xf1\x0\xc7\x0\x2e\x0\x3c\x0\x28\x0\x2b\x0\x21\x0\x26\x0\xe9\x0\xea\x0\xeb\x0\xe8\x0\xed\x0\xee\x0\xef\x0\xec\x0\xdf\x0\x1e\x1\x30\x1\x2a\x0\x29\x0\x3b\x0\x5e\x0\x2d\x0\x2f\x0\xc2\x0\xc4\x0\xc0\x0\xc1\x0\xc3\x0\xc5\x0\x5b\x0\xd1\x0\x5f\x1\x2c\x0\x25\x0\x5f\x0\x3e\x0\x3f\x0\xf8\x0\xc9\x0\xca\x0\xcb\x0\xc8\x0\xcd\x0\xce\x0\xcf\x0\xcc\x0\x31\x1\x3a\x0\xd6\x0\x5e\x1\x27\x0\x3d\x0\xdc\x0\xd8\x0\x61\x0\x62\x0\x63\x0\x64\x0\x65\x0\x66\x0\x67\x0\x68\x0\x69\x0\xab\x0\xbb\x0\x7d\x0\x60\x0\xa6\x0\xb1\x0\xb0\x0\x6a\x0\x6b\x0\x6c\x0\x6d\x0\x6e\x0\x6f\x0\x70\x0\x71\x0\x72\x0\xaa\x0\xba\x0\xe6\x0\xb8\x0\xc6\x0\xa4\x0\xb5\x0\xf6\x0\x73\x0\x74\x0\x75\x0\x76\x0\x77\x0\x78\x0\x79\x0\x7a\x0\xa1\x0\xbf\x0\x5d\x0\x24\x0\x40\x0\xae\x0\xa2\x0\xa3\x0\xa5\x0\xb7\x0\xa9\x0\xa7\x0\xb6\x0\xbc\x0\xbd\x0\xbe\x0\xac\x0\x7c\x0\xaf\x0\xa8\x0\xb4\x0\xd7\x0\xe7\x0\x41\x0\x42\x0\x43\x0\x44\x0\x45\x0\x46\x0\x47\x0\x48\x0\x49\x0\xad\x0\xf4\x0\x7e\x0\xf2\x0\xf3\x0\xf5\x0\x1f\x1\x4a\x0\x4b\x0\x4c\x0\x4d\x0\x4e\x0\x4f\x0\x50\x0\x51\x0\x52\x0\xb9\x0\xfb\x0\x5c\x0\xf9\x0\xfa\x0\xff\x0\xfc\x0\xf7\x0\x53\x0\x54\x0\x55\x0\x56\x0\x57\x0\x58\x0\x59\x0\x5a\x0\xb2\x0\xd4\x0\x23\x0\xd2\x0\xd3\x0\xd5\x0\x30\x0\x31\x0\x32\x0\x33\x0\x34\x0\x35\x0\x36\x0\x37\x0\x38\x0\x39\x0\xb3\x0\xdb\x0\x22\x0\xd9\x0\xda\x0\x9f\x0"#+ , encoderArray = + CompactArray {+ encoderIndices = ConvArray "\x0\x0\x40\x0\x80\x0\xc0\x0\x0\x1\x40\x1"#+ , encoderValues = ConvArray "\x0\x1\x2\x3\x37\x2d\x2e\x2f\x16\x5\x25\xb\xc\xd\xe\xf\x10\x11\x12\x13\x3c\x3d\x32\x26\x18\x19\x3f\x27\x1c\x1d\x1e\x1f\x40\x4f\xfc\xec\xad\x6c\x50\x7d\x4d\x5d\x5c\x4e\x6b\x60\x4b\x61\xf0\xf1\xf2\xf3\xf4\xf5\xf6\xf7\xf8\xf9\x7a\x5e\x4c\x7e\x6e\x6f\xae\xc1\xc2\xc3\xc4\xc5\xc6\xc7\xc8\xc9\xd1\xd2\xd3\xd4\xd5\xd6\xd7\xd8\xd9\xe2\xe3\xe4\xe5\xe6\xe7\xe8\xe9\x68\xdc\xac\x5f\x6d\x8d\x81\x82\x83\x84\x85\x86\x87\x88\x89\x91\x92\x93\x94\x95\x96\x97\x98\x99\xa2\xa3\xa4\xa5\xa6\xa7\xa8\xa9\x48\xbb\x8c\xcc\x7\x20\x21\x22\x23\x24\x15\x6\x17\x28\x29\x2a\x2b\x2c\x9\xa\x1b\x30\x31\x1a\x33\x34\x35\x36\x8\x38\x39\x3a\x3b\x4\x14\x3e\xff\x41\xaa\xb0\xb1\x9f\xb2\x8e\xb5\xbd\xb4\x9a\x8a\xba\xca\xaf\xbc\x90\x8f\xea\xfa\xbe\xa0\xb6\xb3\x9d\xda\x9b\x8b\xb7\xb8\xb9\xab\x64\x65\x62\x66\x63\x67\x9e\x4a\x74\x71\x72\x73\x78\x75\x76\x77\x0\x69\xed\xee\xeb\xef\x7b\xbf\x80\xfd\xfe\xfb\x7f\x0\x0\x59\x44\x45\x42\x46\x43\x47\x9c\xc0\x54\x51\x52\x53\x58\x55\x56\x57\x0\x49\xcd\xce\xcb\xcf\xa1\xe1\x70\xdd\xde\xdb\xe0\x0\x0\xdf\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x5a\xd0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x5b\x79\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x7c\x6a"#+ , encoderMax = '\351'+ }++ }+ )++ ,+ (1250, SingleByteCP {+ decoderArray = ConvArray "\x0\x0\x1\x0\x2\x0\x3\x0\x4\x0\x5\x0\x6\x0\x7\x0\x8\x0\x9\x0\xa\x0\xb\x0\xc\x0\xd\x0\xe\x0\xf\x0\x10\x0\x11\x0\x12\x0\x13\x0\x14\x0\x15\x0\x16\x0\x17\x0\x18\x0\x19\x0\x1a\x0\x1b\x0\x1c\x0\x1d\x0\x1e\x0\x1f\x0\x20\x0\x21\x0\x22\x0\x23\x0\x24\x0\x25\x0\x26\x0\x27\x0\x28\x0\x29\x0\x2a\x0\x2b\x0\x2c\x0\x2d\x0\x2e\x0\x2f\x0\x30\x0\x31\x0\x32\x0\x33\x0\x34\x0\x35\x0\x36\x0\x37\x0\x38\x0\x39\x0\x3a\x0\x3b\x0\x3c\x0\x3d\x0\x3e\x0\x3f\x0\x40\x0\x41\x0\x42\x0\x43\x0\x44\x0\x45\x0\x46\x0\x47\x0\x48\x0\x49\x0\x4a\x0\x4b\x0\x4c\x0\x4d\x0\x4e\x0\x4f\x0\x50\x0\x51\x0\x52\x0\x53\x0\x54\x0\x55\x0\x56\x0\x57\x0\x58\x0\x59\x0\x5a\x0\x5b\x0\x5c\x0\x5d\x0\x5e\x0\x5f\x0\x60\x0\x61\x0\x62\x0\x63\x0\x64\x0\x65\x0\x66\x0\x67\x0\x68\x0\x69\x0\x6a\x0\x6b\x0\x6c\x0\x6d\x0\x6e\x0\x6f\x0\x70\x0\x71\x0\x72\x0\x73\x0\x74\x0\x75\x0\x76\x0\x77\x0\x78\x0\x79\x0\x7a\x0\x7b\x0\x7c\x0\x7d\x0\x7e\x0\x7f\x0\xac\x20\x0\x0\x1a\x20\x0\x0\x1e\x20\x26\x20\x20\x20\x21\x20\x0\x0\x30\x20\x60\x1\x39\x20\x5a\x1\x64\x1\x7d\x1\x79\x1\x0\x0\x18\x20\x19\x20\x1c\x20\x1d\x20\x22\x20\x13\x20\x14\x20\x0\x0\x22\x21\x61\x1\x3a\x20\x5b\x1\x65\x1\x7e\x1\x7a\x1\xa0\x0\xc7\x2\xd8\x2\x41\x1\xa4\x0\x4\x1\xa6\x0\xa7\x0\xa8\x0\xa9\x0\x5e\x1\xab\x0\xac\x0\xad\x0\xae\x0\x7b\x1\xb0\x0\xb1\x0\xdb\x2\x42\x1\xb4\x0\xb5\x0\xb6\x0\xb7\x0\xb8\x0\x5\x1\x5f\x1\xbb\x0\x3d\x1\xdd\x2\x3e\x1\x7c\x1\x54\x1\xc1\x0\xc2\x0\x2\x1\xc4\x0\x39\x1\x6\x1\xc7\x0\xc\x1\xc9\x0\x18\x1\xcb\x0\x1a\x1\xcd\x0\xce\x0\xe\x1\x10\x1\x43\x1\x47\x1\xd3\x0\xd4\x0\x50\x1\xd6\x0\xd7\x0\x58\x1\x6e\x1\xda\x0\x70\x1\xdc\x0\xdd\x0\x62\x1\xdf\x0\x55\x1\xe1\x0\xe2\x0\x3\x1\xe4\x0\x3a\x1\x7\x1\xe7\x0\xd\x1\xe9\x0\x19\x1\xeb\x0\x1b\x1\xed\x0\xee\x0\xf\x1\x11\x1\x44\x1\x48\x1\xf3\x0\xf4\x0\x51\x1\xf6\x0\xf7\x0\x59\x1\x6f\x1\xfa\x0\x71\x1\xfc\x0\xfd\x0\x63\x1\xd9\x2"#+ , encoderArray = + CompactArray {+ encoderIndices = ConvArray "\x0\x0\x40\x0\x80\x0\xc0\x0\x0\x1\x40\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\xc0\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x0\x2\x80\x1\x40\x2\x80\x1\x80\x2"#+ , encoderValues = ConvArray "\x0\x1\x2\x3\x4\x5\x6\x7\x8\x9\xa\xb\xc\xd\xe\xf\x10\x11\x12\x13\x14\x15\x16\x17\x18\x19\x1a\x1b\x1c\x1d\x1e\x1f\x20\x21\x22\x23\x24\x25\x26\x27\x28\x29\x2a\x2b\x2c\x2d\x2e\x2f\x30\x31\x32\x33\x34\x35\x36\x37\x38\x39\x3a\x3b\x3c\x3d\x3e\x3f\x40\x41\x42\x43\x44\x45\x46\x47\x48\x49\x4a\x4b\x4c\x4d\x4e\x4f\x50\x51\x52\x53\x54\x55\x56\x57\x58\x59\x5a\x5b\x5c\x5d\x5e\x5f\x60\x61\x62\x63\x64\x65\x66\x67\x68\x69\x6a\x6b\x6c\x6d\x6e\x6f\x70\x71\x72\x73\x74\x75\x76\x77\x78\x79\x7a\x7b\x7c\x7d\x7e\x7f\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xa0\x0\x0\x0\xa4\x0\xa6\xa7\xa8\xa9\x0\xab\xac\xad\xae\x0\xb0\xb1\x0\x0\xb4\xb5\xb6\xb7\xb8\x0\x0\xbb\x0\x0\x0\x0\x0\xc1\xc2\x0\xc4\x0\x0\xc7\x0\xc9\x0\xcb\x0\xcd\xce\x0\x0\x0\x0\xd3\xd4\x0\xd6\xd7\x0\x0\xda\x0\xdc\xdd\x0\xdf\x0\xe1\xe2\x0\xe4\x0\x0\xe7\x0\xe9\x0\xeb\x0\xed\xee\x0\x0\x0\x0\xf3\xf4\x0\xf6\xf7\x0\x0\xfa\x0\xfc\xfd\x0\x0\x0\x0\xc3\xe3\xa5\xb9\xc6\xe6\x0\x0\x0\x0\xc8\xe8\xcf\xef\xd0\xf0\x0\x0\x0\x0\x0\x0\xca\xea\xcc\xec\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xc5\xe5\x0\x0\xbc\xbe\x0\x0\xa3\xb3\xd1\xf1\x0\x0\xd2\xf2\x0\x0\x0\x0\x0\x0\x0\xd5\xf5\x0\x0\xc0\xe0\x0\x0\xd8\xf8\x8c\x9c\x0\x0\xaa\xba\x8a\x9a\xde\xfe\x8d\x9d\x0\x0\x0\x0\x0\x0\x0\x0\xd9\xf9\xdb\xfb\x0\x0\x0\x0\x0\x0\x0\x8f\x9f\xaf\xbf\x8e\x9e\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xa1\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xa2\xff\x0\xb2\x0\xbd\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x96\x97\x0\x0\x0\x91\x92\x82\x0\x93\x94\x84\x0\x86\x87\x95\x0\x0\x0\x85\x0\x0\x0\x0\x0\x0\x0\x0\x0\x89\x0\x0\x0\x0\x0\x0\x0\x0\x8b\x9b\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x80\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x99"#+ , encoderMax = '\8482'+ }++ }+ )++ ,+ (1251, SingleByteCP {+ decoderArray = ConvArray "\x0\x0\x1\x0\x2\x0\x3\x0\x4\x0\x5\x0\x6\x0\x7\x0\x8\x0\x9\x0\xa\x0\xb\x0\xc\x0\xd\x0\xe\x0\xf\x0\x10\x0\x11\x0\x12\x0\x13\x0\x14\x0\x15\x0\x16\x0\x17\x0\x18\x0\x19\x0\x1a\x0\x1b\x0\x1c\x0\x1d\x0\x1e\x0\x1f\x0\x20\x0\x21\x0\x22\x0\x23\x0\x24\x0\x25\x0\x26\x0\x27\x0\x28\x0\x29\x0\x2a\x0\x2b\x0\x2c\x0\x2d\x0\x2e\x0\x2f\x0\x30\x0\x31\x0\x32\x0\x33\x0\x34\x0\x35\x0\x36\x0\x37\x0\x38\x0\x39\x0\x3a\x0\x3b\x0\x3c\x0\x3d\x0\x3e\x0\x3f\x0\x40\x0\x41\x0\x42\x0\x43\x0\x44\x0\x45\x0\x46\x0\x47\x0\x48\x0\x49\x0\x4a\x0\x4b\x0\x4c\x0\x4d\x0\x4e\x0\x4f\x0\x50\x0\x51\x0\x52\x0\x53\x0\x54\x0\x55\x0\x56\x0\x57\x0\x58\x0\x59\x0\x5a\x0\x5b\x0\x5c\x0\x5d\x0\x5e\x0\x5f\x0\x60\x0\x61\x0\x62\x0\x63\x0\x64\x0\x65\x0\x66\x0\x67\x0\x68\x0\x69\x0\x6a\x0\x6b\x0\x6c\x0\x6d\x0\x6e\x0\x6f\x0\x70\x0\x71\x0\x72\x0\x73\x0\x74\x0\x75\x0\x76\x0\x77\x0\x78\x0\x79\x0\x7a\x0\x7b\x0\x7c\x0\x7d\x0\x7e\x0\x7f\x0\x2\x4\x3\x4\x1a\x20\x53\x4\x1e\x20\x26\x20\x20\x20\x21\x20\xac\x20\x30\x20\x9\x4\x39\x20\xa\x4\xc\x4\xb\x4\xf\x4\x52\x4\x18\x20\x19\x20\x1c\x20\x1d\x20\x22\x20\x13\x20\x14\x20\x0\x0\x22\x21\x59\x4\x3a\x20\x5a\x4\x5c\x4\x5b\x4\x5f\x4\xa0\x0\xe\x4\x5e\x4\x8\x4\xa4\x0\x90\x4\xa6\x0\xa7\x0\x1\x4\xa9\x0\x4\x4\xab\x0\xac\x0\xad\x0\xae\x0\x7\x4\xb0\x0\xb1\x0\x6\x4\x56\x4\x91\x4\xb5\x0\xb6\x0\xb7\x0\x51\x4\x16\x21\x54\x4\xbb\x0\x58\x4\x5\x4\x55\x4\x57\x4\x10\x4\x11\x4\x12\x4\x13\x4\x14\x4\x15\x4\x16\x4\x17\x4\x18\x4\x19\x4\x1a\x4\x1b\x4\x1c\x4\x1d\x4\x1e\x4\x1f\x4\x20\x4\x21\x4\x22\x4\x23\x4\x24\x4\x25\x4\x26\x4\x27\x4\x28\x4\x29\x4\x2a\x4\x2b\x4\x2c\x4\x2d\x4\x2e\x4\x2f\x4\x30\x4\x31\x4\x32\x4\x33\x4\x34\x4\x35\x4\x36\x4\x37\x4\x38\x4\x39\x4\x3a\x4\x3b\x4\x3c\x4\x3d\x4\x3e\x4\x3f\x4\x40\x4\x41\x4\x42\x4\x43\x4\x44\x4\x45\x4\x46\x4\x47\x4\x48\x4\x49\x4\x4a\x4\x4b\x4\x4c\x4\x4d\x4\x4e\x4\x4f\x4"#+ , encoderArray = + CompactArray {+ encoderIndices = ConvArray "\x0\x0\x40\x0\x80\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\x0\x1\x40\x1\x80\x1\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x1\xc0\x0\x0\x2\xc0\x0\x40\x2"#+ , encoderValues = ConvArray "\x0\x1\x2\x3\x4\x5\x6\x7\x8\x9\xa\xb\xc\xd\xe\xf\x10\x11\x12\x13\x14\x15\x16\x17\x18\x19\x1a\x1b\x1c\x1d\x1e\x1f\x20\x21\x22\x23\x24\x25\x26\x27\x28\x29\x2a\x2b\x2c\x2d\x2e\x2f\x30\x31\x32\x33\x34\x35\x36\x37\x38\x39\x3a\x3b\x3c\x3d\x3e\x3f\x40\x41\x42\x43\x44\x45\x46\x47\x48\x49\x4a\x4b\x4c\x4d\x4e\x4f\x50\x51\x52\x53\x54\x55\x56\x57\x58\x59\x5a\x5b\x5c\x5d\x5e\x5f\x60\x61\x62\x63\x64\x65\x66\x67\x68\x69\x6a\x6b\x6c\x6d\x6e\x6f\x70\x71\x72\x73\x74\x75\x76\x77\x78\x79\x7a\x7b\x7c\x7d\x7e\x7f\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xa0\x0\x0\x0\xa4\x0\xa6\xa7\x0\xa9\x0\xab\xac\xad\xae\x0\xb0\xb1\x0\x0\x0\xb5\xb6\xb7\x0\x0\x0\xbb\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xa8\x80\x81\xaa\xbd\xb2\xaf\xa3\x8a\x8c\x8e\x8d\x0\xa1\x8f\xc0\xc1\xc2\xc3\xc4\xc5\xc6\xc7\xc8\xc9\xca\xcb\xcc\xcd\xce\xcf\xd0\xd1\xd2\xd3\xd4\xd5\xd6\xd7\xd8\xd9\xda\xdb\xdc\xdd\xde\xdf\xe0\xe1\xe2\xe3\xe4\xe5\xe6\xe7\xe8\xe9\xea\xeb\xec\xed\xee\xef\xf0\xf1\xf2\xf3\xf4\xf5\xf6\xf7\xf8\xf9\xfa\xfb\xfc\xfd\xfe\xff\x0\xb8\x90\x83\xba\xbe\xb3\xbf\xbc\x9a\x9c\x9e\x9d\x0\xa2\x9f\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xa5\xb4\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x96\x97\x0\x0\x0\x91\x92\x82\x0\x93\x94\x84\x0\x86\x87\x95\x0\x0\x0\x85\x0\x0\x0\x0\x0\x0\x0\x0\x0\x89\x0\x0\x0\x0\x0\x0\x0\x0\x8b\x9b\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x88\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xb9\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x99"#+ , encoderMax = '\8482'+ }++ }+ )++ ,+ (1252, SingleByteCP {+ decoderArray = ConvArray "\x0\x0\x1\x0\x2\x0\x3\x0\x4\x0\x5\x0\x6\x0\x7\x0\x8\x0\x9\x0\xa\x0\xb\x0\xc\x0\xd\x0\xe\x0\xf\x0\x10\x0\x11\x0\x12\x0\x13\x0\x14\x0\x15\x0\x16\x0\x17\x0\x18\x0\x19\x0\x1a\x0\x1b\x0\x1c\x0\x1d\x0\x1e\x0\x1f\x0\x20\x0\x21\x0\x22\x0\x23\x0\x24\x0\x25\x0\x26\x0\x27\x0\x28\x0\x29\x0\x2a\x0\x2b\x0\x2c\x0\x2d\x0\x2e\x0\x2f\x0\x30\x0\x31\x0\x32\x0\x33\x0\x34\x0\x35\x0\x36\x0\x37\x0\x38\x0\x39\x0\x3a\x0\x3b\x0\x3c\x0\x3d\x0\x3e\x0\x3f\x0\x40\x0\x41\x0\x42\x0\x43\x0\x44\x0\x45\x0\x46\x0\x47\x0\x48\x0\x49\x0\x4a\x0\x4b\x0\x4c\x0\x4d\x0\x4e\x0\x4f\x0\x50\x0\x51\x0\x52\x0\x53\x0\x54\x0\x55\x0\x56\x0\x57\x0\x58\x0\x59\x0\x5a\x0\x5b\x0\x5c\x0\x5d\x0\x5e\x0\x5f\x0\x60\x0\x61\x0\x62\x0\x63\x0\x64\x0\x65\x0\x66\x0\x67\x0\x68\x0\x69\x0\x6a\x0\x6b\x0\x6c\x0\x6d\x0\x6e\x0\x6f\x0\x70\x0\x71\x0\x72\x0\x73\x0\x74\x0\x75\x0\x76\x0\x77\x0\x78\x0\x79\x0\x7a\x0\x7b\x0\x7c\x0\x7d\x0\x7e\x0\x7f\x0\xac\x20\x0\x0\x1a\x20\x92\x1\x1e\x20\x26\x20\x20\x20\x21\x20\xc6\x2\x30\x20\x60\x1\x39\x20\x52\x1\x0\x0\x7d\x1\x0\x0\x0\x0\x18\x20\x19\x20\x1c\x20\x1d\x20\x22\x20\x13\x20\x14\x20\xdc\x2\x22\x21\x61\x1\x3a\x20\x53\x1\x0\x0\x7e\x1\x78\x1\xa0\x0\xa1\x0\xa2\x0\xa3\x0\xa4\x0\xa5\x0\xa6\x0\xa7\x0\xa8\x0\xa9\x0\xaa\x0\xab\x0\xac\x0\xad\x0\xae\x0\xaf\x0\xb0\x0\xb1\x0\xb2\x0\xb3\x0\xb4\x0\xb5\x0\xb6\x0\xb7\x0\xb8\x0\xb9\x0\xba\x0\xbb\x0\xbc\x0\xbd\x0\xbe\x0\xbf\x0\xc0\x0\xc1\x0\xc2\x0\xc3\x0\xc4\x0\xc5\x0\xc6\x0\xc7\x0\xc8\x0\xc9\x0\xca\x0\xcb\x0\xcc\x0\xcd\x0\xce\x0\xcf\x0\xd0\x0\xd1\x0\xd2\x0\xd3\x0\xd4\x0\xd5\x0\xd6\x0\xd7\x0\xd8\x0\xd9\x0\xda\x0\xdb\x0\xdc\x0\xdd\x0\xde\x0\xdf\x0\xe0\x0\xe1\x0\xe2\x0\xe3\x0\xe4\x0\xe5\x0\xe6\x0\xe7\x0\xe8\x0\xe9\x0\xea\x0\xeb\x0\xec\x0\xed\x0\xee\x0\xef\x0\xf0\x0\xf1\x0\xf2\x0\xf3\x0\xf4\x0\xf5\x0\xf6\x0\xf7\x0\xf8\x0\xf9\x0\xfa\x0\xfb\x0\xfc\x0\xfd\x0\xfe\x0\xff\x0"#+ , encoderArray = + CompactArray {+ encoderIndices = ConvArray "\x0\x0\x40\x0\x80\x0\xc0\x0\x0\x1\x40\x1\x80\x1\x0\x1\x0\x1\x0\x1\x0\x1\xc0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x2\x0\x1\x40\x2\x0\x1\x80\x2"#+ , encoderValues = ConvArray "\x0\x1\x2\x3\x4\x5\x6\x7\x8\x9\xa\xb\xc\xd\xe\xf\x10\x11\x12\x13\x14\x15\x16\x17\x18\x19\x1a\x1b\x1c\x1d\x1e\x1f\x20\x21\x22\x23\x24\x25\x26\x27\x28\x29\x2a\x2b\x2c\x2d\x2e\x2f\x30\x31\x32\x33\x34\x35\x36\x37\x38\x39\x3a\x3b\x3c\x3d\x3e\x3f\x40\x41\x42\x43\x44\x45\x46\x47\x48\x49\x4a\x4b\x4c\x4d\x4e\x4f\x50\x51\x52\x53\x54\x55\x56\x57\x58\x59\x5a\x5b\x5c\x5d\x5e\x5f\x60\x61\x62\x63\x64\x65\x66\x67\x68\x69\x6a\x6b\x6c\x6d\x6e\x6f\x70\x71\x72\x73\x74\x75\x76\x77\x78\x79\x7a\x7b\x7c\x7d\x7e\x7f\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xa0\xa1\xa2\xa3\xa4\xa5\xa6\xa7\xa8\xa9\xaa\xab\xac\xad\xae\xaf\xb0\xb1\xb2\xb3\xb4\xb5\xb6\xb7\xb8\xb9\xba\xbb\xbc\xbd\xbe\xbf\xc0\xc1\xc2\xc3\xc4\xc5\xc6\xc7\xc8\xc9\xca\xcb\xcc\xcd\xce\xcf\xd0\xd1\xd2\xd3\xd4\xd5\xd6\xd7\xd8\xd9\xda\xdb\xdc\xdd\xde\xdf\xe0\xe1\xe2\xe3\xe4\xe5\xe6\xe7\xe8\xe9\xea\xeb\xec\xed\xee\xef\xf0\xf1\xf2\xf3\xf4\xf5\xf6\xf7\xf8\xf9\xfa\xfb\xfc\xfd\xfe\xff\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x8c\x9c\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x8a\x9a\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x9f\x0\x0\x0\x0\x8e\x9e\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x83\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x88\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x98\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x96\x97\x0\x0\x0\x91\x92\x82\x0\x93\x94\x84\x0\x86\x87\x95\x0\x0\x0\x85\x0\x0\x0\x0\x0\x0\x0\x0\x0\x89\x0\x0\x0\x0\x0\x0\x0\x0\x8b\x9b\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x80\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x99"#+ , encoderMax = '\8482'+ }++ }+ )++ ,+ (1253, SingleByteCP {+ decoderArray = ConvArray "\x0\x0\x1\x0\x2\x0\x3\x0\x4\x0\x5\x0\x6\x0\x7\x0\x8\x0\x9\x0\xa\x0\xb\x0\xc\x0\xd\x0\xe\x0\xf\x0\x10\x0\x11\x0\x12\x0\x13\x0\x14\x0\x15\x0\x16\x0\x17\x0\x18\x0\x19\x0\x1a\x0\x1b\x0\x1c\x0\x1d\x0\x1e\x0\x1f\x0\x20\x0\x21\x0\x22\x0\x23\x0\x24\x0\x25\x0\x26\x0\x27\x0\x28\x0\x29\x0\x2a\x0\x2b\x0\x2c\x0\x2d\x0\x2e\x0\x2f\x0\x30\x0\x31\x0\x32\x0\x33\x0\x34\x0\x35\x0\x36\x0\x37\x0\x38\x0\x39\x0\x3a\x0\x3b\x0\x3c\x0\x3d\x0\x3e\x0\x3f\x0\x40\x0\x41\x0\x42\x0\x43\x0\x44\x0\x45\x0\x46\x0\x47\x0\x48\x0\x49\x0\x4a\x0\x4b\x0\x4c\x0\x4d\x0\x4e\x0\x4f\x0\x50\x0\x51\x0\x52\x0\x53\x0\x54\x0\x55\x0\x56\x0\x57\x0\x58\x0\x59\x0\x5a\x0\x5b\x0\x5c\x0\x5d\x0\x5e\x0\x5f\x0\x60\x0\x61\x0\x62\x0\x63\x0\x64\x0\x65\x0\x66\x0\x67\x0\x68\x0\x69\x0\x6a\x0\x6b\x0\x6c\x0\x6d\x0\x6e\x0\x6f\x0\x70\x0\x71\x0\x72\x0\x73\x0\x74\x0\x75\x0\x76\x0\x77\x0\x78\x0\x79\x0\x7a\x0\x7b\x0\x7c\x0\x7d\x0\x7e\x0\x7f\x0\xac\x20\x0\x0\x1a\x20\x92\x1\x1e\x20\x26\x20\x20\x20\x21\x20\x0\x0\x30\x20\x0\x0\x39\x20\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x18\x20\x19\x20\x1c\x20\x1d\x20\x22\x20\x13\x20\x14\x20\x0\x0\x22\x21\x0\x0\x3a\x20\x0\x0\x0\x0\x0\x0\x0\x0\xa0\x0\x85\x3\x86\x3\xa3\x0\xa4\x0\xa5\x0\xa6\x0\xa7\x0\xa8\x0\xa9\x0\x0\x0\xab\x0\xac\x0\xad\x0\xae\x0\x15\x20\xb0\x0\xb1\x0\xb2\x0\xb3\x0\x84\x3\xb5\x0\xb6\x0\xb7\x0\x88\x3\x89\x3\x8a\x3\xbb\x0\x8c\x3\xbd\x0\x8e\x3\x8f\x3\x90\x3\x91\x3\x92\x3\x93\x3\x94\x3\x95\x3\x96\x3\x97\x3\x98\x3\x99\x3\x9a\x3\x9b\x3\x9c\x3\x9d\x3\x9e\x3\x9f\x3\xa0\x3\xa1\x3\x0\x0\xa3\x3\xa4\x3\xa5\x3\xa6\x3\xa7\x3\xa8\x3\xa9\x3\xaa\x3\xab\x3\xac\x3\xad\x3\xae\x3\xaf\x3\xb0\x3\xb1\x3\xb2\x3\xb3\x3\xb4\x3\xb5\x3\xb6\x3\xb7\x3\xb8\x3\xb9\x3\xba\x3\xbb\x3\xbc\x3\xbd\x3\xbe\x3\xbf\x3\xc0\x3\xc1\x3\xc2\x3\xc3\x3\xc4\x3\xc5\x3\xc6\x3\xc7\x3\xc8\x3\xc9\x3\xca\x3\xcb\x3\xcc\x3\xcd\x3\xce\x3\x0\x0"#+ , encoderArray = + CompactArray {+ encoderIndices = ConvArray "\x0\x0\x40\x0\x80\x0\xc0\x0\xc0\x0\xc0\x0\x0\x1\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\x40\x1\x80\x1\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x1\xc0\x0\x0\x2\xc0\x0\x40\x2"#+ , encoderValues = ConvArray "\x0\x1\x2\x3\x4\x5\x6\x7\x8\x9\xa\xb\xc\xd\xe\xf\x10\x11\x12\x13\x14\x15\x16\x17\x18\x19\x1a\x1b\x1c\x1d\x1e\x1f\x20\x21\x22\x23\x24\x25\x26\x27\x28\x29\x2a\x2b\x2c\x2d\x2e\x2f\x30\x31\x32\x33\x34\x35\x36\x37\x38\x39\x3a\x3b\x3c\x3d\x3e\x3f\x40\x41\x42\x43\x44\x45\x46\x47\x48\x49\x4a\x4b\x4c\x4d\x4e\x4f\x50\x51\x52\x53\x54\x55\x56\x57\x58\x59\x5a\x5b\x5c\x5d\x5e\x5f\x60\x61\x62\x63\x64\x65\x66\x67\x68\x69\x6a\x6b\x6c\x6d\x6e\x6f\x70\x71\x72\x73\x74\x75\x76\x77\x78\x79\x7a\x7b\x7c\x7d\x7e\x7f\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xa0\x0\x0\xa3\xa4\xa5\xa6\xa7\xa8\xa9\x0\xab\xac\xad\xae\x0\xb0\xb1\xb2\xb3\x0\xb5\xb6\xb7\x0\x0\x0\xbb\x0\xbd\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x83\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xb4\xa1\xa2\x0\xb8\xb9\xba\x0\xbc\x0\xbe\xbf\xc0\xc1\xc2\xc3\xc4\xc5\xc6\xc7\xc8\xc9\xca\xcb\xcc\xcd\xce\xcf\xd0\xd1\x0\xd3\xd4\xd5\xd6\xd7\xd8\xd9\xda\xdb\xdc\xdd\xde\xdf\xe0\xe1\xe2\xe3\xe4\xe5\xe6\xe7\xe8\xe9\xea\xeb\xec\xed\xee\xef\xf0\xf1\xf2\xf3\xf4\xf5\xf6\xf7\xf8\xf9\xfa\xfb\xfc\xfd\xfe\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x96\x97\xaf\x0\x0\x91\x92\x82\x0\x93\x94\x84\x0\x86\x87\x95\x0\x0\x0\x85\x0\x0\x0\x0\x0\x0\x0\x0\x0\x89\x0\x0\x0\x0\x0\x0\x0\x0\x8b\x9b\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x80\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x99"#+ , encoderMax = '\8482'+ }++ }+ )++ ,+ (1254, SingleByteCP {+ decoderArray = ConvArray "\x0\x0\x1\x0\x2\x0\x3\x0\x4\x0\x5\x0\x6\x0\x7\x0\x8\x0\x9\x0\xa\x0\xb\x0\xc\x0\xd\x0\xe\x0\xf\x0\x10\x0\x11\x0\x12\x0\x13\x0\x14\x0\x15\x0\x16\x0\x17\x0\x18\x0\x19\x0\x1a\x0\x1b\x0\x1c\x0\x1d\x0\x1e\x0\x1f\x0\x20\x0\x21\x0\x22\x0\x23\x0\x24\x0\x25\x0\x26\x0\x27\x0\x28\x0\x29\x0\x2a\x0\x2b\x0\x2c\x0\x2d\x0\x2e\x0\x2f\x0\x30\x0\x31\x0\x32\x0\x33\x0\x34\x0\x35\x0\x36\x0\x37\x0\x38\x0\x39\x0\x3a\x0\x3b\x0\x3c\x0\x3d\x0\x3e\x0\x3f\x0\x40\x0\x41\x0\x42\x0\x43\x0\x44\x0\x45\x0\x46\x0\x47\x0\x48\x0\x49\x0\x4a\x0\x4b\x0\x4c\x0\x4d\x0\x4e\x0\x4f\x0\x50\x0\x51\x0\x52\x0\x53\x0\x54\x0\x55\x0\x56\x0\x57\x0\x58\x0\x59\x0\x5a\x0\x5b\x0\x5c\x0\x5d\x0\x5e\x0\x5f\x0\x60\x0\x61\x0\x62\x0\x63\x0\x64\x0\x65\x0\x66\x0\x67\x0\x68\x0\x69\x0\x6a\x0\x6b\x0\x6c\x0\x6d\x0\x6e\x0\x6f\x0\x70\x0\x71\x0\x72\x0\x73\x0\x74\x0\x75\x0\x76\x0\x77\x0\x78\x0\x79\x0\x7a\x0\x7b\x0\x7c\x0\x7d\x0\x7e\x0\x7f\x0\xac\x20\x0\x0\x1a\x20\x92\x1\x1e\x20\x26\x20\x20\x20\x21\x20\xc6\x2\x30\x20\x60\x1\x39\x20\x52\x1\x0\x0\x0\x0\x0\x0\x0\x0\x18\x20\x19\x20\x1c\x20\x1d\x20\x22\x20\x13\x20\x14\x20\xdc\x2\x22\x21\x61\x1\x3a\x20\x53\x1\x0\x0\x0\x0\x78\x1\xa0\x0\xa1\x0\xa2\x0\xa3\x0\xa4\x0\xa5\x0\xa6\x0\xa7\x0\xa8\x0\xa9\x0\xaa\x0\xab\x0\xac\x0\xad\x0\xae\x0\xaf\x0\xb0\x0\xb1\x0\xb2\x0\xb3\x0\xb4\x0\xb5\x0\xb6\x0\xb7\x0\xb8\x0\xb9\x0\xba\x0\xbb\x0\xbc\x0\xbd\x0\xbe\x0\xbf\x0\xc0\x0\xc1\x0\xc2\x0\xc3\x0\xc4\x0\xc5\x0\xc6\x0\xc7\x0\xc8\x0\xc9\x0\xca\x0\xcb\x0\xcc\x0\xcd\x0\xce\x0\xcf\x0\x1e\x1\xd1\x0\xd2\x0\xd3\x0\xd4\x0\xd5\x0\xd6\x0\xd7\x0\xd8\x0\xd9\x0\xda\x0\xdb\x0\xdc\x0\x30\x1\x5e\x1\xdf\x0\xe0\x0\xe1\x0\xe2\x0\xe3\x0\xe4\x0\xe5\x0\xe6\x0\xe7\x0\xe8\x0\xe9\x0\xea\x0\xeb\x0\xec\x0\xed\x0\xee\x0\xef\x0\x1f\x1\xf1\x0\xf2\x0\xf3\x0\xf4\x0\xf5\x0\xf6\x0\xf7\x0\xf8\x0\xf9\x0\xfa\x0\xfb\x0\xfc\x0\x31\x1\x5f\x1\xff\x0"#+ , encoderArray = + CompactArray {+ encoderIndices = ConvArray "\x0\x0\x40\x0\x80\x0\xc0\x0\x0\x1\x40\x1\x80\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\x0\x2\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\x40\x2\xc0\x1\x80\x2\xc0\x1\xc0\x2"#+ , encoderValues = ConvArray "\x0\x1\x2\x3\x4\x5\x6\x7\x8\x9\xa\xb\xc\xd\xe\xf\x10\x11\x12\x13\x14\x15\x16\x17\x18\x19\x1a\x1b\x1c\x1d\x1e\x1f\x20\x21\x22\x23\x24\x25\x26\x27\x28\x29\x2a\x2b\x2c\x2d\x2e\x2f\x30\x31\x32\x33\x34\x35\x36\x37\x38\x39\x3a\x3b\x3c\x3d\x3e\x3f\x40\x41\x42\x43\x44\x45\x46\x47\x48\x49\x4a\x4b\x4c\x4d\x4e\x4f\x50\x51\x52\x53\x54\x55\x56\x57\x58\x59\x5a\x5b\x5c\x5d\x5e\x5f\x60\x61\x62\x63\x64\x65\x66\x67\x68\x69\x6a\x6b\x6c\x6d\x6e\x6f\x70\x71\x72\x73\x74\x75\x76\x77\x78\x79\x7a\x7b\x7c\x7d\x7e\x7f\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xa0\xa1\xa2\xa3\xa4\xa5\xa6\xa7\xa8\xa9\xaa\xab\xac\xad\xae\xaf\xb0\xb1\xb2\xb3\xb4\xb5\xb6\xb7\xb8\xb9\xba\xbb\xbc\xbd\xbe\xbf\xc0\xc1\xc2\xc3\xc4\xc5\xc6\xc7\xc8\xc9\xca\xcb\xcc\xcd\xce\xcf\x0\xd1\xd2\xd3\xd4\xd5\xd6\xd7\xd8\xd9\xda\xdb\xdc\x0\x0\xdf\xe0\xe1\xe2\xe3\xe4\xe5\xe6\xe7\xe8\xe9\xea\xeb\xec\xed\xee\xef\x0\xf1\xf2\xf3\xf4\xf5\xf6\xf7\xf8\xf9\xfa\xfb\xfc\x0\x0\xff\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xd0\xf0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xdd\xfd\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x8c\x9c\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xde\xfe\x8a\x9a\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x9f\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x83\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x88\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x98\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x96\x97\x0\x0\x0\x91\x92\x82\x0\x93\x94\x84\x0\x86\x87\x95\x0\x0\x0\x85\x0\x0\x0\x0\x0\x0\x0\x0\x0\x89\x0\x0\x0\x0\x0\x0\x0\x0\x8b\x9b\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x80\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x99"#+ , encoderMax = '\8482'+ }++ }+ )++ ,+ (1255, SingleByteCP {+ decoderArray = ConvArray "\x0\x0\x1\x0\x2\x0\x3\x0\x4\x0\x5\x0\x6\x0\x7\x0\x8\x0\x9\x0\xa\x0\xb\x0\xc\x0\xd\x0\xe\x0\xf\x0\x10\x0\x11\x0\x12\x0\x13\x0\x14\x0\x15\x0\x16\x0\x17\x0\x18\x0\x19\x0\x1a\x0\x1b\x0\x1c\x0\x1d\x0\x1e\x0\x1f\x0\x20\x0\x21\x0\x22\x0\x23\x0\x24\x0\x25\x0\x26\x0\x27\x0\x28\x0\x29\x0\x2a\x0\x2b\x0\x2c\x0\x2d\x0\x2e\x0\x2f\x0\x30\x0\x31\x0\x32\x0\x33\x0\x34\x0\x35\x0\x36\x0\x37\x0\x38\x0\x39\x0\x3a\x0\x3b\x0\x3c\x0\x3d\x0\x3e\x0\x3f\x0\x40\x0\x41\x0\x42\x0\x43\x0\x44\x0\x45\x0\x46\x0\x47\x0\x48\x0\x49\x0\x4a\x0\x4b\x0\x4c\x0\x4d\x0\x4e\x0\x4f\x0\x50\x0\x51\x0\x52\x0\x53\x0\x54\x0\x55\x0\x56\x0\x57\x0\x58\x0\x59\x0\x5a\x0\x5b\x0\x5c\x0\x5d\x0\x5e\x0\x5f\x0\x60\x0\x61\x0\x62\x0\x63\x0\x64\x0\x65\x0\x66\x0\x67\x0\x68\x0\x69\x0\x6a\x0\x6b\x0\x6c\x0\x6d\x0\x6e\x0\x6f\x0\x70\x0\x71\x0\x72\x0\x73\x0\x74\x0\x75\x0\x76\x0\x77\x0\x78\x0\x79\x0\x7a\x0\x7b\x0\x7c\x0\x7d\x0\x7e\x0\x7f\x0\xac\x20\x0\x0\x1a\x20\x92\x1\x1e\x20\x26\x20\x20\x20\x21\x20\xc6\x2\x30\x20\x0\x0\x39\x20\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x18\x20\x19\x20\x1c\x20\x1d\x20\x22\x20\x13\x20\x14\x20\xdc\x2\x22\x21\x0\x0\x3a\x20\x0\x0\x0\x0\x0\x0\x0\x0\xa0\x0\xa1\x0\xa2\x0\xa3\x0\xaa\x20\xa5\x0\xa6\x0\xa7\x0\xa8\x0\xa9\x0\xd7\x0\xab\x0\xac\x0\xad\x0\xae\x0\xaf\x0\xb0\x0\xb1\x0\xb2\x0\xb3\x0\xb4\x0\xb5\x0\xb6\x0\xb7\x0\xb8\x0\xb9\x0\xf7\x0\xbb\x0\xbc\x0\xbd\x0\xbe\x0\xbf\x0\xb0\x5\xb1\x5\xb2\x5\xb3\x5\xb4\x5\xb5\x5\xb6\x5\xb7\x5\xb8\x5\xb9\x5\x0\x0\xbb\x5\xbc\x5\xbd\x5\xbe\x5\xbf\x5\xc0\x5\xc1\x5\xc2\x5\xc3\x5\xf0\x5\xf1\x5\xf2\x5\xf3\x5\xf4\x5\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xd0\x5\xd1\x5\xd2\x5\xd3\x5\xd4\x5\xd5\x5\xd6\x5\xd7\x5\xd8\x5\xd9\x5\xda\x5\xdb\x5\xdc\x5\xdd\x5\xde\x5\xdf\x5\xe0\x5\xe1\x5\xe2\x5\xe3\x5\xe4\x5\xe5\x5\xe6\x5\xe7\x5\xe8\x5\xe9\x5\xea\x5\x0\x0\x0\x0\xe\x20\xf\x20\x0\x0"#+ , encoderArray = + CompactArray {+ encoderIndices = ConvArray "\x0\x0\x40\x0\x80\x0\xc0\x0\x0\x1\x0\x1\x40\x1\x0\x1\x0\x1\x0\x1\x0\x1\x80\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\xc0\x1\x0\x2\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x40\x2\x0\x1\x80\x2\x0\x1\xc0\x2"#+ , encoderValues = ConvArray "\x0\x1\x2\x3\x4\x5\x6\x7\x8\x9\xa\xb\xc\xd\xe\xf\x10\x11\x12\x13\x14\x15\x16\x17\x18\x19\x1a\x1b\x1c\x1d\x1e\x1f\x20\x21\x22\x23\x24\x25\x26\x27\x28\x29\x2a\x2b\x2c\x2d\x2e\x2f\x30\x31\x32\x33\x34\x35\x36\x37\x38\x39\x3a\x3b\x3c\x3d\x3e\x3f\x40\x41\x42\x43\x44\x45\x46\x47\x48\x49\x4a\x4b\x4c\x4d\x4e\x4f\x50\x51\x52\x53\x54\x55\x56\x57\x58\x59\x5a\x5b\x5c\x5d\x5e\x5f\x60\x61\x62\x63\x64\x65\x66\x67\x68\x69\x6a\x6b\x6c\x6d\x6e\x6f\x70\x71\x72\x73\x74\x75\x76\x77\x78\x79\x7a\x7b\x7c\x7d\x7e\x7f\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xa0\xa1\xa2\xa3\x0\xa5\xa6\xa7\xa8\xa9\x0\xab\xac\xad\xae\xaf\xb0\xb1\xb2\xb3\xb4\xb5\xb6\xb7\xb8\xb9\x0\xbb\xbc\xbd\xbe\xbf\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xaa\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xba\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x83\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x88\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x98\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xc0\xc1\xc2\xc3\xc4\xc5\xc6\xc7\xc8\xc9\x0\xcb\xcc\xcd\xce\xcf\xd0\xd1\xd2\xd3\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xe0\xe1\xe2\xe3\xe4\xe5\xe6\xe7\xe8\xe9\xea\xeb\xec\xed\xee\xef\xf0\xf1\xf2\xf3\xf4\xf5\xf6\xf7\xf8\xf9\xfa\x0\x0\x0\x0\x0\xd4\xd5\xd6\xd7\xd8\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xfd\xfe\x0\x0\x0\x96\x97\x0\x0\x0\x91\x92\x82\x0\x93\x94\x84\x0\x86\x87\x95\x0\x0\x0\x85\x0\x0\x0\x0\x0\x0\x0\x0\x0\x89\x0\x0\x0\x0\x0\x0\x0\x0\x8b\x9b\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xa4\x0\x80\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x99"#+ , encoderMax = '\8482'+ }++ }+ )++ ,+ (1256, SingleByteCP {+ decoderArray = ConvArray "\x0\x0\x1\x0\x2\x0\x3\x0\x4\x0\x5\x0\x6\x0\x7\x0\x8\x0\x9\x0\xa\x0\xb\x0\xc\x0\xd\x0\xe\x0\xf\x0\x10\x0\x11\x0\x12\x0\x13\x0\x14\x0\x15\x0\x16\x0\x17\x0\x18\x0\x19\x0\x1a\x0\x1b\x0\x1c\x0\x1d\x0\x1e\x0\x1f\x0\x20\x0\x21\x0\x22\x0\x23\x0\x24\x0\x25\x0\x26\x0\x27\x0\x28\x0\x29\x0\x2a\x0\x2b\x0\x2c\x0\x2d\x0\x2e\x0\x2f\x0\x30\x0\x31\x0\x32\x0\x33\x0\x34\x0\x35\x0\x36\x0\x37\x0\x38\x0\x39\x0\x3a\x0\x3b\x0\x3c\x0\x3d\x0\x3e\x0\x3f\x0\x40\x0\x41\x0\x42\x0\x43\x0\x44\x0\x45\x0\x46\x0\x47\x0\x48\x0\x49\x0\x4a\x0\x4b\x0\x4c\x0\x4d\x0\x4e\x0\x4f\x0\x50\x0\x51\x0\x52\x0\x53\x0\x54\x0\x55\x0\x56\x0\x57\x0\x58\x0\x59\x0\x5a\x0\x5b\x0\x5c\x0\x5d\x0\x5e\x0\x5f\x0\x60\x0\x61\x0\x62\x0\x63\x0\x64\x0\x65\x0\x66\x0\x67\x0\x68\x0\x69\x0\x6a\x0\x6b\x0\x6c\x0\x6d\x0\x6e\x0\x6f\x0\x70\x0\x71\x0\x72\x0\x73\x0\x74\x0\x75\x0\x76\x0\x77\x0\x78\x0\x79\x0\x7a\x0\x7b\x0\x7c\x0\x7d\x0\x7e\x0\x7f\x0\xac\x20\x7e\x6\x1a\x20\x92\x1\x1e\x20\x26\x20\x20\x20\x21\x20\xc6\x2\x30\x20\x79\x6\x39\x20\x52\x1\x86\x6\x98\x6\x88\x6\xaf\x6\x18\x20\x19\x20\x1c\x20\x1d\x20\x22\x20\x13\x20\x14\x20\xa9\x6\x22\x21\x91\x6\x3a\x20\x53\x1\xc\x20\xd\x20\xba\x6\xa0\x0\xc\x6\xa2\x0\xa3\x0\xa4\x0\xa5\x0\xa6\x0\xa7\x0\xa8\x0\xa9\x0\xbe\x6\xab\x0\xac\x0\xad\x0\xae\x0\xaf\x0\xb0\x0\xb1\x0\xb2\x0\xb3\x0\xb4\x0\xb5\x0\xb6\x0\xb7\x0\xb8\x0\xb9\x0\x1b\x6\xbb\x0\xbc\x0\xbd\x0\xbe\x0\x1f\x6\xc1\x6\x21\x6\x22\x6\x23\x6\x24\x6\x25\x6\x26\x6\x27\x6\x28\x6\x29\x6\x2a\x6\x2b\x6\x2c\x6\x2d\x6\x2e\x6\x2f\x6\x30\x6\x31\x6\x32\x6\x33\x6\x34\x6\x35\x6\x36\x6\xd7\x0\x37\x6\x38\x6\x39\x6\x3a\x6\x40\x6\x41\x6\x42\x6\x43\x6\xe0\x0\x44\x6\xe2\x0\x45\x6\x46\x6\x47\x6\x48\x6\xe7\x0\xe8\x0\xe9\x0\xea\x0\xeb\x0\x49\x6\x4a\x6\xee\x0\xef\x0\x4b\x6\x4c\x6\x4d\x6\x4e\x6\xf4\x0\x4f\x6\x50\x6\xf7\x0\x51\x6\xf9\x0\x52\x6\xfb\x0\xfc\x0\xe\x20\xf\x20\xd2\x6"#+ , encoderArray = + CompactArray {+ encoderIndices = ConvArray "\x0\x0\x40\x0\x80\x0\xc0\x0\x0\x1\x40\x1\x80\x1\x0\x1\x0\x1\x0\x1\x0\x1\xc0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x2\x40\x2\x80\x2\xc0\x2\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x3\x0\x1\x40\x3\x0\x1\x80\x3"#+ , encoderValues = ConvArray "\x0\x1\x2\x3\x4\x5\x6\x7\x8\x9\xa\xb\xc\xd\xe\xf\x10\x11\x12\x13\x14\x15\x16\x17\x18\x19\x1a\x1b\x1c\x1d\x1e\x1f\x20\x21\x22\x23\x24\x25\x26\x27\x28\x29\x2a\x2b\x2c\x2d\x2e\x2f\x30\x31\x32\x33\x34\x35\x36\x37\x38\x39\x3a\x3b\x3c\x3d\x3e\x3f\x40\x41\x42\x43\x44\x45\x46\x47\x48\x49\x4a\x4b\x4c\x4d\x4e\x4f\x50\x51\x52\x53\x54\x55\x56\x57\x58\x59\x5a\x5b\x5c\x5d\x5e\x5f\x60\x61\x62\x63\x64\x65\x66\x67\x68\x69\x6a\x6b\x6c\x6d\x6e\x6f\x70\x71\x72\x73\x74\x75\x76\x77\x78\x79\x7a\x7b\x7c\x7d\x7e\x7f\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xa0\x0\xa2\xa3\xa4\xa5\xa6\xa7\xa8\xa9\x0\xab\xac\xad\xae\xaf\xb0\xb1\xb2\xb3\xb4\xb5\xb6\xb7\xb8\xb9\x0\xbb\xbc\xbd\xbe\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xd7\x0\x0\x0\x0\x0\x0\x0\x0\xe0\x0\xe2\x0\x0\x0\x0\xe7\xe8\xe9\xea\xeb\x0\x0\xee\xef\x0\x0\x0\x0\xf4\x0\x0\xf7\x0\xf9\x0\xfb\xfc\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x8c\x9c\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x83\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x88\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xa1\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xba\x0\x0\x0\xbf\x0\xc1\xc2\xc3\xc4\xc5\xc6\xc7\xc8\xc9\xca\xcb\xcc\xcd\xce\xcf\xd0\xd1\xd2\xd3\xd4\xd5\xd6\xd8\xd9\xda\xdb\x0\x0\x0\x0\x0\xdc\xdd\xde\xdf\xe1\xe3\xe4\xe5\xe6\xec\xed\xf0\xf1\xf2\xf3\xf5\xf6\xf8\xfa\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x8a\x0\x0\x0\x0\x81\x0\x0\x0\x0\x0\x0\x0\x8d\x0\x8f\x0\x0\x0\x0\x0\x0\x0\x0\x9a\x0\x0\x0\x0\x0\x0\x8e\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x98\x0\x0\x0\x0\x0\x90\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x9f\x0\x0\x0\xaa\x0\x0\xc0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xff\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x9d\x9e\xfd\xfe\x0\x0\x0\x96\x97\x0\x0\x0\x91\x92\x82\x0\x93\x94\x84\x0\x86\x87\x95\x0\x0\x0\x85\x0\x0\x0\x0\x0\x0\x0\x0\x0\x89\x0\x0\x0\x0\x0\x0\x0\x0\x8b\x9b\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x80\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x99"#+ , encoderMax = '\8482'+ }++ }+ )++ ,+ (1257, SingleByteCP {+ decoderArray = ConvArray "\x0\x0\x1\x0\x2\x0\x3\x0\x4\x0\x5\x0\x6\x0\x7\x0\x8\x0\x9\x0\xa\x0\xb\x0\xc\x0\xd\x0\xe\x0\xf\x0\x10\x0\x11\x0\x12\x0\x13\x0\x14\x0\x15\x0\x16\x0\x17\x0\x18\x0\x19\x0\x1a\x0\x1b\x0\x1c\x0\x1d\x0\x1e\x0\x1f\x0\x20\x0\x21\x0\x22\x0\x23\x0\x24\x0\x25\x0\x26\x0\x27\x0\x28\x0\x29\x0\x2a\x0\x2b\x0\x2c\x0\x2d\x0\x2e\x0\x2f\x0\x30\x0\x31\x0\x32\x0\x33\x0\x34\x0\x35\x0\x36\x0\x37\x0\x38\x0\x39\x0\x3a\x0\x3b\x0\x3c\x0\x3d\x0\x3e\x0\x3f\x0\x40\x0\x41\x0\x42\x0\x43\x0\x44\x0\x45\x0\x46\x0\x47\x0\x48\x0\x49\x0\x4a\x0\x4b\x0\x4c\x0\x4d\x0\x4e\x0\x4f\x0\x50\x0\x51\x0\x52\x0\x53\x0\x54\x0\x55\x0\x56\x0\x57\x0\x58\x0\x59\x0\x5a\x0\x5b\x0\x5c\x0\x5d\x0\x5e\x0\x5f\x0\x60\x0\x61\x0\x62\x0\x63\x0\x64\x0\x65\x0\x66\x0\x67\x0\x68\x0\x69\x0\x6a\x0\x6b\x0\x6c\x0\x6d\x0\x6e\x0\x6f\x0\x70\x0\x71\x0\x72\x0\x73\x0\x74\x0\x75\x0\x76\x0\x77\x0\x78\x0\x79\x0\x7a\x0\x7b\x0\x7c\x0\x7d\x0\x7e\x0\x7f\x0\xac\x20\x0\x0\x1a\x20\x0\x0\x1e\x20\x26\x20\x20\x20\x21\x20\x0\x0\x30\x20\x0\x0\x39\x20\x0\x0\xa8\x0\xc7\x2\xb8\x0\x0\x0\x18\x20\x19\x20\x1c\x20\x1d\x20\x22\x20\x13\x20\x14\x20\x0\x0\x22\x21\x0\x0\x3a\x20\x0\x0\xaf\x0\xdb\x2\x0\x0\xa0\x0\x0\x0\xa2\x0\xa3\x0\xa4\x0\x0\x0\xa6\x0\xa7\x0\xd8\x0\xa9\x0\x56\x1\xab\x0\xac\x0\xad\x0\xae\x0\xc6\x0\xb0\x0\xb1\x0\xb2\x0\xb3\x0\xb4\x0\xb5\x0\xb6\x0\xb7\x0\xf8\x0\xb9\x0\x57\x1\xbb\x0\xbc\x0\xbd\x0\xbe\x0\xe6\x0\x4\x1\x2e\x1\x0\x1\x6\x1\xc4\x0\xc5\x0\x18\x1\x12\x1\xc\x1\xc9\x0\x79\x1\x16\x1\x22\x1\x36\x1\x2a\x1\x3b\x1\x60\x1\x43\x1\x45\x1\xd3\x0\x4c\x1\xd5\x0\xd6\x0\xd7\x0\x72\x1\x41\x1\x5a\x1\x6a\x1\xdc\x0\x7b\x1\x7d\x1\xdf\x0\x5\x1\x2f\x1\x1\x1\x7\x1\xe4\x0\xe5\x0\x19\x1\x13\x1\xd\x1\xe9\x0\x7a\x1\x17\x1\x23\x1\x37\x1\x2b\x1\x3c\x1\x61\x1\x44\x1\x46\x1\xf3\x0\x4d\x1\xf5\x0\xf6\x0\xf7\x0\x73\x1\x42\x1\x5b\x1\x6b\x1\xfc\x0\x7c\x1\x7e\x1\xd9\x2"#+ , encoderArray = + CompactArray {+ encoderIndices = ConvArray "\x0\x0\x40\x0\x80\x0\xc0\x0\x0\x1\x40\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\xc0\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x0\x2\x80\x1\x40\x2\x80\x1\x80\x2"#+ , encoderValues = ConvArray "\x0\x1\x2\x3\x4\x5\x6\x7\x8\x9\xa\xb\xc\xd\xe\xf\x10\x11\x12\x13\x14\x15\x16\x17\x18\x19\x1a\x1b\x1c\x1d\x1e\x1f\x20\x21\x22\x23\x24\x25\x26\x27\x28\x29\x2a\x2b\x2c\x2d\x2e\x2f\x30\x31\x32\x33\x34\x35\x36\x37\x38\x39\x3a\x3b\x3c\x3d\x3e\x3f\x40\x41\x42\x43\x44\x45\x46\x47\x48\x49\x4a\x4b\x4c\x4d\x4e\x4f\x50\x51\x52\x53\x54\x55\x56\x57\x58\x59\x5a\x5b\x5c\x5d\x5e\x5f\x60\x61\x62\x63\x64\x65\x66\x67\x68\x69\x6a\x6b\x6c\x6d\x6e\x6f\x70\x71\x72\x73\x74\x75\x76\x77\x78\x79\x7a\x7b\x7c\x7d\x7e\x7f\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xa0\x0\xa2\xa3\xa4\x0\xa6\xa7\x8d\xa9\x0\xab\xac\xad\xae\x9d\xb0\xb1\xb2\xb3\xb4\xb5\xb6\xb7\x8f\xb9\x0\xbb\xbc\xbd\xbe\x0\x0\x0\x0\x0\xc4\xc5\xaf\x0\x0\xc9\x0\x0\x0\x0\x0\x0\x0\x0\x0\xd3\x0\xd5\xd6\xd7\xa8\x0\x0\x0\xdc\x0\x0\xdf\x0\x0\x0\x0\xe4\xe5\xbf\x0\x0\xe9\x0\x0\x0\x0\x0\x0\x0\x0\x0\xf3\x0\xf5\xf6\xf7\xb8\x0\x0\x0\xfc\x0\x0\x0\xc2\xe2\x0\x0\xc0\xe0\xc3\xe3\x0\x0\x0\x0\xc8\xe8\x0\x0\x0\x0\xc7\xe7\x0\x0\xcb\xeb\xc6\xe6\x0\x0\x0\x0\x0\x0\x0\x0\xcc\xec\x0\x0\x0\x0\x0\x0\xce\xee\x0\x0\xc1\xe1\x0\x0\x0\x0\x0\x0\xcd\xed\x0\x0\x0\xcf\xef\x0\x0\x0\x0\xd9\xf9\xd1\xf1\xd2\xf2\x0\x0\x0\x0\x0\xd4\xf4\x0\x0\x0\x0\x0\x0\x0\x0\xaa\xba\x0\x0\xda\xfa\x0\x0\x0\x0\xd0\xf0\x0\x0\x0\x0\x0\x0\x0\x0\xdb\xfb\x0\x0\x0\x0\x0\x0\xd8\xf8\x0\x0\x0\x0\x0\xca\xea\xdd\xfd\xde\xfe\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x8e\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xff\x0\x9e\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x96\x97\x0\x0\x0\x91\x92\x82\x0\x93\x94\x84\x0\x86\x87\x95\x0\x0\x0\x85\x0\x0\x0\x0\x0\x0\x0\x0\x0\x89\x0\x0\x0\x0\x0\x0\x0\x0\x8b\x9b\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x80\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x99"#+ , encoderMax = '\8482'+ }++ }+ )++ ,+ (1258, SingleByteCP {+ decoderArray = ConvArray "\x0\x0\x1\x0\x2\x0\x3\x0\x4\x0\x5\x0\x6\x0\x7\x0\x8\x0\x9\x0\xa\x0\xb\x0\xc\x0\xd\x0\xe\x0\xf\x0\x10\x0\x11\x0\x12\x0\x13\x0\x14\x0\x15\x0\x16\x0\x17\x0\x18\x0\x19\x0\x1a\x0\x1b\x0\x1c\x0\x1d\x0\x1e\x0\x1f\x0\x20\x0\x21\x0\x22\x0\x23\x0\x24\x0\x25\x0\x26\x0\x27\x0\x28\x0\x29\x0\x2a\x0\x2b\x0\x2c\x0\x2d\x0\x2e\x0\x2f\x0\x30\x0\x31\x0\x32\x0\x33\x0\x34\x0\x35\x0\x36\x0\x37\x0\x38\x0\x39\x0\x3a\x0\x3b\x0\x3c\x0\x3d\x0\x3e\x0\x3f\x0\x40\x0\x41\x0\x42\x0\x43\x0\x44\x0\x45\x0\x46\x0\x47\x0\x48\x0\x49\x0\x4a\x0\x4b\x0\x4c\x0\x4d\x0\x4e\x0\x4f\x0\x50\x0\x51\x0\x52\x0\x53\x0\x54\x0\x55\x0\x56\x0\x57\x0\x58\x0\x59\x0\x5a\x0\x5b\x0\x5c\x0\x5d\x0\x5e\x0\x5f\x0\x60\x0\x61\x0\x62\x0\x63\x0\x64\x0\x65\x0\x66\x0\x67\x0\x68\x0\x69\x0\x6a\x0\x6b\x0\x6c\x0\x6d\x0\x6e\x0\x6f\x0\x70\x0\x71\x0\x72\x0\x73\x0\x74\x0\x75\x0\x76\x0\x77\x0\x78\x0\x79\x0\x7a\x0\x7b\x0\x7c\x0\x7d\x0\x7e\x0\x7f\x0\xac\x20\x0\x0\x1a\x20\x92\x1\x1e\x20\x26\x20\x20\x20\x21\x20\xc6\x2\x30\x20\x0\x0\x39\x20\x52\x1\x0\x0\x0\x0\x0\x0\x0\x0\x18\x20\x19\x20\x1c\x20\x1d\x20\x22\x20\x13\x20\x14\x20\xdc\x2\x22\x21\x0\x0\x3a\x20\x53\x1\x0\x0\x0\x0\x78\x1\xa0\x0\xa1\x0\xa2\x0\xa3\x0\xa4\x0\xa5\x0\xa6\x0\xa7\x0\xa8\x0\xa9\x0\xaa\x0\xab\x0\xac\x0\xad\x0\xae\x0\xaf\x0\xb0\x0\xb1\x0\xb2\x0\xb3\x0\xb4\x0\xb5\x0\xb6\x0\xb7\x0\xb8\x0\xb9\x0\xba\x0\xbb\x0\xbc\x0\xbd\x0\xbe\x0\xbf\x0\xc0\x0\xc1\x0\xc2\x0\x2\x1\xc4\x0\xc5\x0\xc6\x0\xc7\x0\xc8\x0\xc9\x0\xca\x0\xcb\x0\x0\x3\xcd\x0\xce\x0\xcf\x0\x10\x1\xd1\x0\x9\x3\xd3\x0\xd4\x0\xa0\x1\xd6\x0\xd7\x0\xd8\x0\xd9\x0\xda\x0\xdb\x0\xdc\x0\xaf\x1\x3\x3\xdf\x0\xe0\x0\xe1\x0\xe2\x0\x3\x1\xe4\x0\xe5\x0\xe6\x0\xe7\x0\xe8\x0\xe9\x0\xea\x0\xeb\x0\x1\x3\xed\x0\xee\x0\xef\x0\x11\x1\xf1\x0\x23\x3\xf3\x0\xf4\x0\xa1\x1\xf6\x0\xf7\x0\xf8\x0\xf9\x0\xfa\x0\xfb\x0\xfc\x0\xb0\x1\xab\x20\xff\x0"#+ , encoderArray = + CompactArray {+ encoderIndices = ConvArray "\x0\x0\x40\x0\x80\x0\xc0\x0\x0\x1\x40\x1\x80\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\x0\x2\x40\x2\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\x80\x2\xc0\x1\xc0\x2\xc0\x1\x0\x3"#+ , encoderValues = ConvArray "\x0\x1\x2\x3\x4\x5\x6\x7\x8\x9\xa\xb\xc\xd\xe\xf\x10\x11\x12\x13\x14\x15\x16\x17\x18\x19\x1a\x1b\x1c\x1d\x1e\x1f\x20\x21\x22\x23\x24\x25\x26\x27\x28\x29\x2a\x2b\x2c\x2d\x2e\x2f\x30\x31\x32\x33\x34\x35\x36\x37\x38\x39\x3a\x3b\x3c\x3d\x3e\x3f\x40\x41\x42\x43\x44\x45\x46\x47\x48\x49\x4a\x4b\x4c\x4d\x4e\x4f\x50\x51\x52\x53\x54\x55\x56\x57\x58\x59\x5a\x5b\x5c\x5d\x5e\x5f\x60\x61\x62\x63\x64\x65\x66\x67\x68\x69\x6a\x6b\x6c\x6d\x6e\x6f\x70\x71\x72\x73\x74\x75\x76\x77\x78\x79\x7a\x7b\x7c\x7d\x7e\x7f\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xa0\xa1\xa2\xa3\xa4\xa5\xa6\xa7\xa8\xa9\xaa\xab\xac\xad\xae\xaf\xb0\xb1\xb2\xb3\xb4\xb5\xb6\xb7\xb8\xb9\xba\xbb\xbc\xbd\xbe\xbf\xc0\xc1\xc2\x0\xc4\xc5\xc6\xc7\xc8\xc9\xca\xcb\x0\xcd\xce\xcf\x0\xd1\x0\xd3\xd4\x0\xd6\xd7\xd8\xd9\xda\xdb\xdc\x0\x0\xdf\xe0\xe1\xe2\x0\xe4\xe5\xe6\xe7\xe8\xe9\xea\xeb\x0\xed\xee\xef\x0\xf1\x0\xf3\xf4\x0\xf6\xf7\xf8\xf9\xfa\xfb\xfc\x0\x0\xff\x0\x0\xc3\xe3\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xd0\xf0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x8c\x9c\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x9f\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x83\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xd5\xf5\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xdd\xfd\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x88\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x98\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xcc\xec\x0\xde\x0\x0\x0\x0\x0\xd2\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xf2\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x96\x97\x0\x0\x0\x91\x92\x82\x0\x93\x94\x84\x0\x86\x87\x95\x0\x0\x0\x85\x0\x0\x0\x0\x0\x0\x0\x0\x0\x89\x0\x0\x0\x0\x0\x0\x0\x0\x8b\x9b\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xfe\x80\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x99"#+ , encoderMax = '\8482'+ }++ }+ )++ ,+ (437, SingleByteCP {+ decoderArray = ConvArray "\x0\x0\x1\x0\x2\x0\x3\x0\x4\x0\x5\x0\x6\x0\x7\x0\x8\x0\x9\x0\xa\x0\xb\x0\xc\x0\xd\x0\xe\x0\xf\x0\x10\x0\x11\x0\x12\x0\x13\x0\x14\x0\x15\x0\x16\x0\x17\x0\x18\x0\x19\x0\x1a\x0\x1b\x0\x1c\x0\x1d\x0\x1e\x0\x1f\x0\x20\x0\x21\x0\x22\x0\x23\x0\x24\x0\x25\x0\x26\x0\x27\x0\x28\x0\x29\x0\x2a\x0\x2b\x0\x2c\x0\x2d\x0\x2e\x0\x2f\x0\x30\x0\x31\x0\x32\x0\x33\x0\x34\x0\x35\x0\x36\x0\x37\x0\x38\x0\x39\x0\x3a\x0\x3b\x0\x3c\x0\x3d\x0\x3e\x0\x3f\x0\x40\x0\x41\x0\x42\x0\x43\x0\x44\x0\x45\x0\x46\x0\x47\x0\x48\x0\x49\x0\x4a\x0\x4b\x0\x4c\x0\x4d\x0\x4e\x0\x4f\x0\x50\x0\x51\x0\x52\x0\x53\x0\x54\x0\x55\x0\x56\x0\x57\x0\x58\x0\x59\x0\x5a\x0\x5b\x0\x5c\x0\x5d\x0\x5e\x0\x5f\x0\x60\x0\x61\x0\x62\x0\x63\x0\x64\x0\x65\x0\x66\x0\x67\x0\x68\x0\x69\x0\x6a\x0\x6b\x0\x6c\x0\x6d\x0\x6e\x0\x6f\x0\x70\x0\x71\x0\x72\x0\x73\x0\x74\x0\x75\x0\x76\x0\x77\x0\x78\x0\x79\x0\x7a\x0\x7b\x0\x7c\x0\x7d\x0\x7e\x0\x7f\x0\xc7\x0\xfc\x0\xe9\x0\xe2\x0\xe4\x0\xe0\x0\xe5\x0\xe7\x0\xea\x0\xeb\x0\xe8\x0\xef\x0\xee\x0\xec\x0\xc4\x0\xc5\x0\xc9\x0\xe6\x0\xc6\x0\xf4\x0\xf6\x0\xf2\x0\xfb\x0\xf9\x0\xff\x0\xd6\x0\xdc\x0\xa2\x0\xa3\x0\xa5\x0\xa7\x20\x92\x1\xe1\x0\xed\x0\xf3\x0\xfa\x0\xf1\x0\xd1\x0\xaa\x0\xba\x0\xbf\x0\x10\x23\xac\x0\xbd\x0\xbc\x0\xa1\x0\xab\x0\xbb\x0\x91\x25\x92\x25\x93\x25\x2\x25\x24\x25\x61\x25\x62\x25\x56\x25\x55\x25\x63\x25\x51\x25\x57\x25\x5d\x25\x5c\x25\x5b\x25\x10\x25\x14\x25\x34\x25\x2c\x25\x1c\x25\x0\x25\x3c\x25\x5e\x25\x5f\x25\x5a\x25\x54\x25\x69\x25\x66\x25\x60\x25\x50\x25\x6c\x25\x67\x25\x68\x25\x64\x25\x65\x25\x59\x25\x58\x25\x52\x25\x53\x25\x6b\x25\x6a\x25\x18\x25\xc\x25\x88\x25\x84\x25\x8c\x25\x90\x25\x80\x25\xb1\x3\xdf\x0\x93\x3\xc0\x3\xa3\x3\xc3\x3\xb5\x0\xc4\x3\xa6\x3\x98\x3\xa9\x3\xb4\x3\x1e\x22\xc6\x3\xb5\x3\x29\x22\x61\x22\xb1\x0\x65\x22\x64\x22\x20\x23\x21\x23\xf7\x0\x48\x22\xb0\x0\x19\x22\xb7\x0\x1a\x22\x7f\x20\xb2\x0\xa0\x25\xa0\x0"#+ , encoderArray = + CompactArray {+ encoderIndices = ConvArray "\x0\x0\x40\x0\x80\x0\xc0\x0\x0\x1\x0\x1\x40\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x80\x1\xc0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x2\x40\x2\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x80\x2\xc0\x2\x0\x1\x0\x1\x0\x3\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x40\x3\x80\x3\xc0\x3"#+ , encoderValues = ConvArray "\x0\x1\x2\x3\x4\x5\x6\x7\x8\x9\xa\xb\xc\xd\xe\xf\x10\x11\x12\x13\x14\x15\x16\x17\x18\x19\x1a\x1b\x1c\x1d\x1e\x1f\x20\x21\x22\x23\x24\x25\x26\x27\x28\x29\x2a\x2b\x2c\x2d\x2e\x2f\x30\x31\x32\x33\x34\x35\x36\x37\x38\x39\x3a\x3b\x3c\x3d\x3e\x3f\x40\x41\x42\x43\x44\x45\x46\x47\x48\x49\x4a\x4b\x4c\x4d\x4e\x4f\x50\x51\x52\x53\x54\x55\x56\x57\x58\x59\x5a\x5b\x5c\x5d\x5e\x5f\x60\x61\x62\x63\x64\x65\x66\x67\x68\x69\x6a\x6b\x6c\x6d\x6e\x6f\x70\x71\x72\x73\x74\x75\x76\x77\x78\x79\x7a\x7b\x7c\x7d\x7e\x7f\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xff\xad\x9b\x9c\x0\x9d\x0\x0\x0\x0\xa6\xae\xaa\x0\x0\x0\xf8\xf1\xfd\x0\x0\xe6\x0\xfa\x0\x0\xa7\xaf\xac\xab\x0\xa8\x0\x0\x0\x0\x8e\x8f\x92\x80\x0\x90\x0\x0\x0\x0\x0\x0\x0\xa5\x0\x0\x0\x0\x99\x0\x0\x0\x0\x0\x9a\x0\x0\xe1\x85\xa0\x83\x0\x84\x86\x91\x87\x8a\x82\x88\x89\x8d\xa1\x8c\x8b\x0\xa4\x95\xa2\x93\x0\x94\xf6\x0\x97\xa3\x96\x81\x0\x0\x98\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x9f\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xe2\x0\x0\x0\x0\xe9\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xe4\x0\x0\xe8\x0\x0\xea\x0\x0\x0\x0\x0\x0\x0\xe0\x0\x0\xeb\xee\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xe3\x0\x0\xe5\xe7\x0\xed\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xfc\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x9e\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xf9\xfb\x0\x0\x0\xec\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xef\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xf7\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xf0\x0\x0\xf3\xf2\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xa9\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xf4\xf5\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xc4\x0\xb3\x0\x0\x0\x0\x0\x0\x0\x0\x0\xda\x0\x0\x0\xbf\x0\x0\x0\xc0\x0\x0\x0\xd9\x0\x0\x0\xc3\x0\x0\x0\x0\x0\x0\x0\xb4\x0\x0\x0\x0\x0\x0\x0\xc2\x0\x0\x0\x0\x0\x0\x0\xc1\x0\x0\x0\x0\x0\x0\x0\xc5\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xcd\xba\xd5\xd6\xc9\xb8\xb7\xbb\xd4\xd3\xc8\xbe\xbd\xbc\xc6\xc7\xcc\xb5\xb6\xb9\xd1\xd2\xcb\xcf\xd0\xca\xd8\xd7\xce\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xdf\x0\x0\x0\xdc\x0\x0\x0\xdb\x0\x0\x0\xdd\x0\x0\x0\xde\xb0\xb1\xb2\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xfe"#+ , encoderMax = '\9632'+ }++ }+ )++ ,+ (500, SingleByteCP {+ decoderArray = ConvArray "\x0\x0\x1\x0\x2\x0\x3\x0\x9c\x0\x9\x0\x86\x0\x7f\x0\x97\x0\x8d\x0\x8e\x0\xb\x0\xc\x0\xd\x0\xe\x0\xf\x0\x10\x0\x11\x0\x12\x0\x13\x0\x9d\x0\x85\x0\x8\x0\x87\x0\x18\x0\x19\x0\x92\x0\x8f\x0\x1c\x0\x1d\x0\x1e\x0\x1f\x0\x80\x0\x81\x0\x82\x0\x83\x0\x84\x0\xa\x0\x17\x0\x1b\x0\x88\x0\x89\x0\x8a\x0\x8b\x0\x8c\x0\x5\x0\x6\x0\x7\x0\x90\x0\x91\x0\x16\x0\x93\x0\x94\x0\x95\x0\x96\x0\x4\x0\x98\x0\x99\x0\x9a\x0\x9b\x0\x14\x0\x15\x0\x9e\x0\x1a\x0\x20\x0\xa0\x0\xe2\x0\xe4\x0\xe0\x0\xe1\x0\xe3\x0\xe5\x0\xe7\x0\xf1\x0\x5b\x0\x2e\x0\x3c\x0\x28\x0\x2b\x0\x21\x0\x26\x0\xe9\x0\xea\x0\xeb\x0\xe8\x0\xed\x0\xee\x0\xef\x0\xec\x0\xdf\x0\x5d\x0\x24\x0\x2a\x0\x29\x0\x3b\x0\x5e\x0\x2d\x0\x2f\x0\xc2\x0\xc4\x0\xc0\x0\xc1\x0\xc3\x0\xc5\x0\xc7\x0\xd1\x0\xa6\x0\x2c\x0\x25\x0\x5f\x0\x3e\x0\x3f\x0\xf8\x0\xc9\x0\xca\x0\xcb\x0\xc8\x0\xcd\x0\xce\x0\xcf\x0\xcc\x0\x60\x0\x3a\x0\x23\x0\x40\x0\x27\x0\x3d\x0\x22\x0\xd8\x0\x61\x0\x62\x0\x63\x0\x64\x0\x65\x0\x66\x0\x67\x0\x68\x0\x69\x0\xab\x0\xbb\x0\xf0\x0\xfd\x0\xfe\x0\xb1\x0\xb0\x0\x6a\x0\x6b\x0\x6c\x0\x6d\x0\x6e\x0\x6f\x0\x70\x0\x71\x0\x72\x0\xaa\x0\xba\x0\xe6\x0\xb8\x0\xc6\x0\xa4\x0\xb5\x0\x7e\x0\x73\x0\x74\x0\x75\x0\x76\x0\x77\x0\x78\x0\x79\x0\x7a\x0\xa1\x0\xbf\x0\xd0\x0\xdd\x0\xde\x0\xae\x0\xa2\x0\xa3\x0\xa5\x0\xb7\x0\xa9\x0\xa7\x0\xb6\x0\xbc\x0\xbd\x0\xbe\x0\xac\x0\x7c\x0\xaf\x0\xa8\x0\xb4\x0\xd7\x0\x7b\x0\x41\x0\x42\x0\x43\x0\x44\x0\x45\x0\x46\x0\x47\x0\x48\x0\x49\x0\xad\x0\xf4\x0\xf6\x0\xf2\x0\xf3\x0\xf5\x0\x7d\x0\x4a\x0\x4b\x0\x4c\x0\x4d\x0\x4e\x0\x4f\x0\x50\x0\x51\x0\x52\x0\xb9\x0\xfb\x0\xfc\x0\xf9\x0\xfa\x0\xff\x0\x5c\x0\xf7\x0\x53\x0\x54\x0\x55\x0\x56\x0\x57\x0\x58\x0\x59\x0\x5a\x0\xb2\x0\xd4\x0\xd6\x0\xd2\x0\xd3\x0\xd5\x0\x30\x0\x31\x0\x32\x0\x33\x0\x34\x0\x35\x0\x36\x0\x37\x0\x38\x0\x39\x0\xb3\x0\xdb\x0\xdc\x0\xd9\x0\xda\x0\x9f\x0"#+ , encoderArray = + CompactArray {+ encoderIndices = ConvArray "\x0\x0\x40\x0\x80\x0\xc0\x0"#+ , encoderValues = ConvArray "\x0\x1\x2\x3\x37\x2d\x2e\x2f\x16\x5\x25\xb\xc\xd\xe\xf\x10\x11\x12\x13\x3c\x3d\x32\x26\x18\x19\x3f\x27\x1c\x1d\x1e\x1f\x40\x4f\x7f\x7b\x5b\x6c\x50\x7d\x4d\x5d\x5c\x4e\x6b\x60\x4b\x61\xf0\xf1\xf2\xf3\xf4\xf5\xf6\xf7\xf8\xf9\x7a\x5e\x4c\x7e\x6e\x6f\x7c\xc1\xc2\xc3\xc4\xc5\xc6\xc7\xc8\xc9\xd1\xd2\xd3\xd4\xd5\xd6\xd7\xd8\xd9\xe2\xe3\xe4\xe5\xe6\xe7\xe8\xe9\x4a\xe0\x5a\x5f\x6d\x79\x81\x82\x83\x84\x85\x86\x87\x88\x89\x91\x92\x93\x94\x95\x96\x97\x98\x99\xa2\xa3\xa4\xa5\xa6\xa7\xa8\xa9\xc0\xbb\xd0\xa1\x7\x20\x21\x22\x23\x24\x15\x6\x17\x28\x29\x2a\x2b\x2c\x9\xa\x1b\x30\x31\x1a\x33\x34\x35\x36\x8\x38\x39\x3a\x3b\x4\x14\x3e\xff\x41\xaa\xb0\xb1\x9f\xb2\x6a\xb5\xbd\xb4\x9a\x8a\xba\xca\xaf\xbc\x90\x8f\xea\xfa\xbe\xa0\xb6\xb3\x9d\xda\x9b\x8b\xb7\xb8\xb9\xab\x64\x65\x62\x66\x63\x67\x9e\x68\x74\x71\x72\x73\x78\x75\x76\x77\xac\x69\xed\xee\xeb\xef\xec\xbf\x80\xfd\xfe\xfb\xfc\xad\xae\x59\x44\x45\x42\x46\x43\x47\x9c\x48\x54\x51\x52\x53\x58\x55\x56\x57\x8c\x49\xcd\xce\xcb\xcf\xcc\xe1\x70\xdd\xde\xdb\xdc\x8d\x8e\xdf"#+ , encoderMax = '\255'+ }++ }+ )++ ,+ (737, SingleByteCP {+ decoderArray = ConvArray "\x0\x0\x1\x0\x2\x0\x3\x0\x4\x0\x5\x0\x6\x0\x7\x0\x8\x0\x9\x0\xa\x0\xb\x0\xc\x0\xd\x0\xe\x0\xf\x0\x10\x0\x11\x0\x12\x0\x13\x0\x14\x0\x15\x0\x16\x0\x17\x0\x18\x0\x19\x0\x1a\x0\x1b\x0\x1c\x0\x1d\x0\x1e\x0\x1f\x0\x20\x0\x21\x0\x22\x0\x23\x0\x24\x0\x25\x0\x26\x0\x27\x0\x28\x0\x29\x0\x2a\x0\x2b\x0\x2c\x0\x2d\x0\x2e\x0\x2f\x0\x30\x0\x31\x0\x32\x0\x33\x0\x34\x0\x35\x0\x36\x0\x37\x0\x38\x0\x39\x0\x3a\x0\x3b\x0\x3c\x0\x3d\x0\x3e\x0\x3f\x0\x40\x0\x41\x0\x42\x0\x43\x0\x44\x0\x45\x0\x46\x0\x47\x0\x48\x0\x49\x0\x4a\x0\x4b\x0\x4c\x0\x4d\x0\x4e\x0\x4f\x0\x50\x0\x51\x0\x52\x0\x53\x0\x54\x0\x55\x0\x56\x0\x57\x0\x58\x0\x59\x0\x5a\x0\x5b\x0\x5c\x0\x5d\x0\x5e\x0\x5f\x0\x60\x0\x61\x0\x62\x0\x63\x0\x64\x0\x65\x0\x66\x0\x67\x0\x68\x0\x69\x0\x6a\x0\x6b\x0\x6c\x0\x6d\x0\x6e\x0\x6f\x0\x70\x0\x71\x0\x72\x0\x73\x0\x74\x0\x75\x0\x76\x0\x77\x0\x78\x0\x79\x0\x7a\x0\x7b\x0\x7c\x0\x7d\x0\x7e\x0\x7f\x0\x91\x3\x92\x3\x93\x3\x94\x3\x95\x3\x96\x3\x97\x3\x98\x3\x99\x3\x9a\x3\x9b\x3\x9c\x3\x9d\x3\x9e\x3\x9f\x3\xa0\x3\xa1\x3\xa3\x3\xa4\x3\xa5\x3\xa6\x3\xa7\x3\xa8\x3\xa9\x3\xb1\x3\xb2\x3\xb3\x3\xb4\x3\xb5\x3\xb6\x3\xb7\x3\xb8\x3\xb9\x3\xba\x3\xbb\x3\xbc\x3\xbd\x3\xbe\x3\xbf\x3\xc0\x3\xc1\x3\xc3\x3\xc2\x3\xc4\x3\xc5\x3\xc6\x3\xc7\x3\xc8\x3\x91\x25\x92\x25\x93\x25\x2\x25\x24\x25\x61\x25\x62\x25\x56\x25\x55\x25\x63\x25\x51\x25\x57\x25\x5d\x25\x5c\x25\x5b\x25\x10\x25\x14\x25\x34\x25\x2c\x25\x1c\x25\x0\x25\x3c\x25\x5e\x25\x5f\x25\x5a\x25\x54\x25\x69\x25\x66\x25\x60\x25\x50\x25\x6c\x25\x67\x25\x68\x25\x64\x25\x65\x25\x59\x25\x58\x25\x52\x25\x53\x25\x6b\x25\x6a\x25\x18\x25\xc\x25\x88\x25\x84\x25\x8c\x25\x90\x25\x80\x25\xc9\x3\xac\x3\xad\x3\xae\x3\xca\x3\xaf\x3\xcc\x3\xcd\x3\xcb\x3\xce\x3\x86\x3\x88\x3\x89\x3\x8a\x3\x8c\x3\x8e\x3\x8f\x3\xb1\x0\x65\x22\x64\x22\xaa\x3\xab\x3\xf7\x0\x48\x22\xb0\x0\x19\x22\xb7\x0\x1a\x22\x7f\x20\xb2\x0\xa0\x25\xa0\x0"#+ , encoderArray = + CompactArray {+ encoderIndices = ConvArray "\x0\x0\x40\x0\x80\x0\xc0\x0\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x40\x1\x80\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\xc0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x2\x40\x2\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x80\x2\xc0\x2\x0\x3"#+ , encoderValues = ConvArray "\x0\x1\x2\x3\x4\x5\x6\x7\x8\x9\xa\xb\xc\xd\xe\xf\x10\x11\x12\x13\x14\x15\x16\x17\x18\x19\x1a\x1b\x1c\x1d\x1e\x1f\x20\x21\x22\x23\x24\x25\x26\x27\x28\x29\x2a\x2b\x2c\x2d\x2e\x2f\x30\x31\x32\x33\x34\x35\x36\x37\x38\x39\x3a\x3b\x3c\x3d\x3e\x3f\x40\x41\x42\x43\x44\x45\x46\x47\x48\x49\x4a\x4b\x4c\x4d\x4e\x4f\x50\x51\x52\x53\x54\x55\x56\x57\x58\x59\x5a\x5b\x5c\x5d\x5e\x5f\x60\x61\x62\x63\x64\x65\x66\x67\x68\x69\x6a\x6b\x6c\x6d\x6e\x6f\x70\x71\x72\x73\x74\x75\x76\x77\x78\x79\x7a\x7b\x7c\x7d\x7e\x7f\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xff\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xf8\xf1\xfd\x0\x0\x0\x0\xfa\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xf6\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xea\x0\xeb\xec\xed\x0\xee\x0\xef\xf0\x0\x80\x81\x82\x83\x84\x85\x86\x87\x88\x89\x8a\x8b\x8c\x8d\x8e\x8f\x90\x0\x91\x92\x93\x94\x95\x96\x97\xf4\xf5\xe1\xe2\xe3\xe5\x0\x98\x99\x9a\x9b\x9c\x9d\x9e\x9f\xa0\xa1\xa2\xa3\xa4\xa5\xa6\xa7\xa8\xaa\xa9\xab\xac\xad\xae\xaf\xe0\xe4\xe8\xe6\xe7\xe9\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xfc\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xf9\xfb\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xf7\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xf3\xf2\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xc4\x0\xb3\x0\x0\x0\x0\x0\x0\x0\x0\x0\xda\x0\x0\x0\xbf\x0\x0\x0\xc0\x0\x0\x0\xd9\x0\x0\x0\xc3\x0\x0\x0\x0\x0\x0\x0\xb4\x0\x0\x0\x0\x0\x0\x0\xc2\x0\x0\x0\x0\x0\x0\x0\xc1\x0\x0\x0\x0\x0\x0\x0\xc5\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xcd\xba\xd5\xd6\xc9\xb8\xb7\xbb\xd4\xd3\xc8\xbe\xbd\xbc\xc6\xc7\xcc\xb5\xb6\xb9\xd1\xd2\xcb\xcf\xd0\xca\xd8\xd7\xce\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xdf\x0\x0\x0\xdc\x0\x0\x0\xdb\x0\x0\x0\xdd\x0\x0\x0\xde\xb0\xb1\xb2\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xfe"#+ , encoderMax = '\9632'+ }++ }+ )++ ,+ (775, SingleByteCP {+ decoderArray = ConvArray "\x0\x0\x1\x0\x2\x0\x3\x0\x4\x0\x5\x0\x6\x0\x7\x0\x8\x0\x9\x0\xa\x0\xb\x0\xc\x0\xd\x0\xe\x0\xf\x0\x10\x0\x11\x0\x12\x0\x13\x0\x14\x0\x15\x0\x16\x0\x17\x0\x18\x0\x19\x0\x1a\x0\x1b\x0\x1c\x0\x1d\x0\x1e\x0\x1f\x0\x20\x0\x21\x0\x22\x0\x23\x0\x24\x0\x25\x0\x26\x0\x27\x0\x28\x0\x29\x0\x2a\x0\x2b\x0\x2c\x0\x2d\x0\x2e\x0\x2f\x0\x30\x0\x31\x0\x32\x0\x33\x0\x34\x0\x35\x0\x36\x0\x37\x0\x38\x0\x39\x0\x3a\x0\x3b\x0\x3c\x0\x3d\x0\x3e\x0\x3f\x0\x40\x0\x41\x0\x42\x0\x43\x0\x44\x0\x45\x0\x46\x0\x47\x0\x48\x0\x49\x0\x4a\x0\x4b\x0\x4c\x0\x4d\x0\x4e\x0\x4f\x0\x50\x0\x51\x0\x52\x0\x53\x0\x54\x0\x55\x0\x56\x0\x57\x0\x58\x0\x59\x0\x5a\x0\x5b\x0\x5c\x0\x5d\x0\x5e\x0\x5f\x0\x60\x0\x61\x0\x62\x0\x63\x0\x64\x0\x65\x0\x66\x0\x67\x0\x68\x0\x69\x0\x6a\x0\x6b\x0\x6c\x0\x6d\x0\x6e\x0\x6f\x0\x70\x0\x71\x0\x72\x0\x73\x0\x74\x0\x75\x0\x76\x0\x77\x0\x78\x0\x79\x0\x7a\x0\x7b\x0\x7c\x0\x7d\x0\x7e\x0\x7f\x0\x6\x1\xfc\x0\xe9\x0\x1\x1\xe4\x0\x23\x1\xe5\x0\x7\x1\x42\x1\x13\x1\x56\x1\x57\x1\x2b\x1\x79\x1\xc4\x0\xc5\x0\xc9\x0\xe6\x0\xc6\x0\x4d\x1\xf6\x0\x22\x1\xa2\x0\x5a\x1\x5b\x1\xd6\x0\xdc\x0\xf8\x0\xa3\x0\xd8\x0\xd7\x0\xa4\x0\x0\x1\x2a\x1\xf3\x0\x7b\x1\x7c\x1\x7a\x1\x1d\x20\xa6\x0\xa9\x0\xae\x0\xac\x0\xbd\x0\xbc\x0\x41\x1\xab\x0\xbb\x0\x91\x25\x92\x25\x93\x25\x2\x25\x24\x25\x4\x1\xc\x1\x18\x1\x16\x1\x63\x25\x51\x25\x57\x25\x5d\x25\x2e\x1\x60\x1\x10\x25\x14\x25\x34\x25\x2c\x25\x1c\x25\x0\x25\x3c\x25\x72\x1\x6a\x1\x5a\x25\x54\x25\x69\x25\x66\x25\x60\x25\x50\x25\x6c\x25\x7d\x1\x5\x1\xd\x1\x19\x1\x17\x1\x2f\x1\x61\x1\x73\x1\x6b\x1\x7e\x1\x18\x25\xc\x25\x88\x25\x84\x25\x8c\x25\x90\x25\x80\x25\xd3\x0\xdf\x0\x4c\x1\x43\x1\xf5\x0\xd5\x0\xb5\x0\x44\x1\x36\x1\x37\x1\x3b\x1\x3c\x1\x46\x1\x12\x1\x45\x1\x19\x20\xad\x0\xb1\x0\x1c\x20\xbe\x0\xb6\x0\xa7\x0\xf7\x0\x1e\x20\xb0\x0\x19\x22\xb7\x0\xb9\x0\xb3\x0\xb2\x0\xa0\x25\xa0\x0"#+ , encoderArray = + CompactArray {+ encoderIndices = ConvArray "\x0\x0\x40\x0\x80\x0\xc0\x0\x0\x1\x40\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\xc0\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x0\x2\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x40\x2\x80\x2\xc0\x2"#+ , encoderValues = ConvArray "\x0\x1\x2\x3\x4\x5\x6\x7\x8\x9\xa\xb\xc\xd\xe\xf\x10\x11\x12\x13\x14\x15\x16\x17\x18\x19\x1a\x1b\x1c\x1d\x1e\x1f\x20\x21\x22\x23\x24\x25\x26\x27\x28\x29\x2a\x2b\x2c\x2d\x2e\x2f\x30\x31\x32\x33\x34\x35\x36\x37\x38\x39\x3a\x3b\x3c\x3d\x3e\x3f\x40\x41\x42\x43\x44\x45\x46\x47\x48\x49\x4a\x4b\x4c\x4d\x4e\x4f\x50\x51\x52\x53\x54\x55\x56\x57\x58\x59\x5a\x5b\x5c\x5d\x5e\x5f\x60\x61\x62\x63\x64\x65\x66\x67\x68\x69\x6a\x6b\x6c\x6d\x6e\x6f\x70\x71\x72\x73\x74\x75\x76\x77\x78\x79\x7a\x7b\x7c\x7d\x7e\x7f\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xff\x0\x96\x9c\x9f\x0\xa7\xf5\x0\xa8\x0\xae\xaa\xf0\xa9\x0\xf8\xf1\xfd\xfc\x0\xe6\xf4\xfa\x0\xfb\x0\xaf\xac\xab\xf3\x0\x0\x0\x0\x0\x8e\x8f\x92\x0\x0\x90\x0\x0\x0\x0\x0\x0\x0\x0\x0\xe0\x0\xe5\x99\x9e\x9d\x0\x0\x0\x9a\x0\x0\xe1\x0\x0\x0\x0\x84\x86\x91\x0\x0\x82\x0\x0\x0\x0\x0\x0\x0\x0\x0\xa2\x0\xe4\x94\xf6\x9b\x0\x0\x0\x81\x0\x0\x0\xa0\x83\x0\x0\xb5\xd0\x80\x87\x0\x0\x0\x0\xb6\xd1\x0\x0\x0\x0\xed\x89\x0\x0\xb8\xd3\xb7\xd2\x0\x0\x0\x0\x0\x0\x0\x0\x95\x85\x0\x0\x0\x0\x0\x0\xa1\x8c\x0\x0\xbd\xd4\x0\x0\x0\x0\x0\x0\xe8\xe9\x0\x0\x0\xea\xeb\x0\x0\x0\x0\xad\x88\xe3\xe7\xee\xec\x0\x0\x0\x0\x0\xe2\x93\x0\x0\x0\x0\x0\x0\x0\x0\x8a\x8b\x0\x0\x97\x98\x0\x0\x0\x0\xbe\xd5\x0\x0\x0\x0\x0\x0\x0\x0\xc7\xd7\x0\x0\x0\x0\x0\x0\xc6\xd6\x0\x0\x0\x0\x0\x8d\xa5\xa3\xa4\xcf\xd8\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xef\x0\x0\xf2\xa6\xf7\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xf9\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xc4\x0\xb3\x0\x0\x0\x0\x0\x0\x0\x0\x0\xda\x0\x0\x0\xbf\x0\x0\x0\xc0\x0\x0\x0\xd9\x0\x0\x0\xc3\x0\x0\x0\x0\x0\x0\x0\xb4\x0\x0\x0\x0\x0\x0\x0\xc2\x0\x0\x0\x0\x0\x0\x0\xc1\x0\x0\x0\x0\x0\x0\x0\xc5\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xcd\xba\x0\x0\xc9\x0\x0\xbb\x0\x0\xc8\x0\x0\xbc\x0\x0\xcc\x0\x0\xb9\x0\x0\xcb\x0\x0\xca\x0\x0\xce\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xdf\x0\x0\x0\xdc\x0\x0\x0\xdb\x0\x0\x0\xdd\x0\x0\x0\xde\xb0\xb1\xb2\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xfe"#+ , encoderMax = '\9632'+ }++ }+ )++ ,+ (850, SingleByteCP {+ decoderArray = ConvArray "\x0\x0\x1\x0\x2\x0\x3\x0\x4\x0\x5\x0\x6\x0\x7\x0\x8\x0\x9\x0\xa\x0\xb\x0\xc\x0\xd\x0\xe\x0\xf\x0\x10\x0\x11\x0\x12\x0\x13\x0\x14\x0\x15\x0\x16\x0\x17\x0\x18\x0\x19\x0\x1a\x0\x1b\x0\x1c\x0\x1d\x0\x1e\x0\x1f\x0\x20\x0\x21\x0\x22\x0\x23\x0\x24\x0\x25\x0\x26\x0\x27\x0\x28\x0\x29\x0\x2a\x0\x2b\x0\x2c\x0\x2d\x0\x2e\x0\x2f\x0\x30\x0\x31\x0\x32\x0\x33\x0\x34\x0\x35\x0\x36\x0\x37\x0\x38\x0\x39\x0\x3a\x0\x3b\x0\x3c\x0\x3d\x0\x3e\x0\x3f\x0\x40\x0\x41\x0\x42\x0\x43\x0\x44\x0\x45\x0\x46\x0\x47\x0\x48\x0\x49\x0\x4a\x0\x4b\x0\x4c\x0\x4d\x0\x4e\x0\x4f\x0\x50\x0\x51\x0\x52\x0\x53\x0\x54\x0\x55\x0\x56\x0\x57\x0\x58\x0\x59\x0\x5a\x0\x5b\x0\x5c\x0\x5d\x0\x5e\x0\x5f\x0\x60\x0\x61\x0\x62\x0\x63\x0\x64\x0\x65\x0\x66\x0\x67\x0\x68\x0\x69\x0\x6a\x0\x6b\x0\x6c\x0\x6d\x0\x6e\x0\x6f\x0\x70\x0\x71\x0\x72\x0\x73\x0\x74\x0\x75\x0\x76\x0\x77\x0\x78\x0\x79\x0\x7a\x0\x7b\x0\x7c\x0\x7d\x0\x7e\x0\x7f\x0\xc7\x0\xfc\x0\xe9\x0\xe2\x0\xe4\x0\xe0\x0\xe5\x0\xe7\x0\xea\x0\xeb\x0\xe8\x0\xef\x0\xee\x0\xec\x0\xc4\x0\xc5\x0\xc9\x0\xe6\x0\xc6\x0\xf4\x0\xf6\x0\xf2\x0\xfb\x0\xf9\x0\xff\x0\xd6\x0\xdc\x0\xf8\x0\xa3\x0\xd8\x0\xd7\x0\x92\x1\xe1\x0\xed\x0\xf3\x0\xfa\x0\xf1\x0\xd1\x0\xaa\x0\xba\x0\xbf\x0\xae\x0\xac\x0\xbd\x0\xbc\x0\xa1\x0\xab\x0\xbb\x0\x91\x25\x92\x25\x93\x25\x2\x25\x24\x25\xc1\x0\xc2\x0\xc0\x0\xa9\x0\x63\x25\x51\x25\x57\x25\x5d\x25\xa2\x0\xa5\x0\x10\x25\x14\x25\x34\x25\x2c\x25\x1c\x25\x0\x25\x3c\x25\xe3\x0\xc3\x0\x5a\x25\x54\x25\x69\x25\x66\x25\x60\x25\x50\x25\x6c\x25\xa4\x0\xf0\x0\xd0\x0\xca\x0\xcb\x0\xc8\x0\x31\x1\xcd\x0\xce\x0\xcf\x0\x18\x25\xc\x25\x88\x25\x84\x25\xa6\x0\xcc\x0\x80\x25\xd3\x0\xdf\x0\xd4\x0\xd2\x0\xf5\x0\xd5\x0\xb5\x0\xfe\x0\xde\x0\xda\x0\xdb\x0\xd9\x0\xfd\x0\xdd\x0\xaf\x0\xb4\x0\xad\x0\xb1\x0\x17\x20\xbe\x0\xb6\x0\xa7\x0\xf7\x0\xb8\x0\xb0\x0\xa8\x0\xb7\x0\xb9\x0\xb3\x0\xb2\x0\xa0\x25\xa0\x0"#+ , encoderArray = + CompactArray {+ encoderIndices = ConvArray "\x0\x0\x40\x0\x80\x0\xc0\x0\x0\x1\x40\x1\x80\x1\x40\x1\x40\x1\x40\x1\x40\x1\x40\x1\x40\x1\x40\x1\x40\x1\x40\x1\x40\x1\x40\x1\x40\x1\x40\x1\x40\x1\x40\x1\x40\x1\x40\x1\x40\x1\x40\x1\x40\x1\x40\x1\x40\x1\x40\x1\x40\x1\x40\x1\x40\x1\x40\x1\x40\x1\x40\x1\x40\x1\x40\x1\x40\x1\x40\x1\x40\x1\x40\x1\x40\x1\x40\x1\x40\x1\x40\x1\x40\x1\x40\x1\x40\x1\x40\x1\x40\x1\x40\x1\x40\x1\x40\x1\x40\x1\x40\x1\x40\x1\x40\x1\x40\x1\x40\x1\x40\x1\x40\x1\x40\x1\x40\x1\x40\x1\x40\x1\x40\x1\x40\x1\x40\x1\x40\x1\x40\x1\x40\x1\x40\x1\x40\x1\x40\x1\x40\x1\x40\x1\x40\x1\x40\x1\x40\x1\x40\x1\x40\x1\x40\x1\x40\x1\x40\x1\x40\x1\x40\x1\x40\x1\x40\x1\x40\x1\x40\x1\x40\x1\x40\x1\x40\x1\x40\x1\x40\x1\x40\x1\x40\x1\x40\x1\x40\x1\x40\x1\x40\x1\x40\x1\x40\x1\x40\x1\x40\x1\x40\x1\x40\x1\x40\x1\x40\x1\x40\x1\x40\x1\x40\x1\x40\x1\x40\x1\x40\x1\x40\x1\x40\x1\x40\x1\x40\x1\x40\x1\x40\x1\x40\x1\x40\x1\x40\x1\x40\x1\x40\x1\x40\x1\xc0\x1\x40\x1\x40\x1\x40\x1\x40\x1\x40\x1\x40\x1\x40\x1\x40\x1\x40\x1\x40\x1\x40\x1\x40\x1\x40\x1\x40\x1\x40\x1\x40\x1\x40\x1\x40\x1\x40\x1\x0\x2\x40\x2\x80\x2"#+ , encoderValues = ConvArray "\x0\x1\x2\x3\x4\x5\x6\x7\x8\x9\xa\xb\xc\xd\xe\xf\x10\x11\x12\x13\x14\x15\x16\x17\x18\x19\x1a\x1b\x1c\x1d\x1e\x1f\x20\x21\x22\x23\x24\x25\x26\x27\x28\x29\x2a\x2b\x2c\x2d\x2e\x2f\x30\x31\x32\x33\x34\x35\x36\x37\x38\x39\x3a\x3b\x3c\x3d\x3e\x3f\x40\x41\x42\x43\x44\x45\x46\x47\x48\x49\x4a\x4b\x4c\x4d\x4e\x4f\x50\x51\x52\x53\x54\x55\x56\x57\x58\x59\x5a\x5b\x5c\x5d\x5e\x5f\x60\x61\x62\x63\x64\x65\x66\x67\x68\x69\x6a\x6b\x6c\x6d\x6e\x6f\x70\x71\x72\x73\x74\x75\x76\x77\x78\x79\x7a\x7b\x7c\x7d\x7e\x7f\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xff\xad\xbd\x9c\xcf\xbe\xdd\xf5\xf9\xb8\xa6\xae\xaa\xf0\xa9\xee\xf8\xf1\xfd\xfc\xef\xe6\xf4\xfa\xf7\xfb\xa7\xaf\xac\xab\xf3\xa8\xb7\xb5\xb6\xc7\x8e\x8f\x92\x80\xd4\x90\xd2\xd3\xde\xd6\xd7\xd8\xd1\xa5\xe3\xe0\xe2\xe5\x99\x9e\x9d\xeb\xe9\xea\x9a\xed\xe8\xe1\x85\xa0\x83\xc6\x84\x86\x91\x87\x8a\x82\x88\x89\x8d\xa1\x8c\x8b\xd0\xa4\x95\xa2\x93\xe4\x94\xf6\x9b\x97\xa3\x96\x81\xec\xe7\x98\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xd5\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x9f\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xf2\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xc4\x0\xb3\x0\x0\x0\x0\x0\x0\x0\x0\x0\xda\x0\x0\x0\xbf\x0\x0\x0\xc0\x0\x0\x0\xd9\x0\x0\x0\xc3\x0\x0\x0\x0\x0\x0\x0\xb4\x0\x0\x0\x0\x0\x0\x0\xc2\x0\x0\x0\x0\x0\x0\x0\xc1\x0\x0\x0\x0\x0\x0\x0\xc5\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xcd\xba\x0\x0\xc9\x0\x0\xbb\x0\x0\xc8\x0\x0\xbc\x0\x0\xcc\x0\x0\xb9\x0\x0\xcb\x0\x0\xca\x0\x0\xce\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xdf\x0\x0\x0\xdc\x0\x0\x0\xdb\x0\x0\x0\x0\x0\x0\x0\x0\xb0\xb1\xb2\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xfe"#+ , encoderMax = '\9632'+ }++ }+ )++ ,+ (852, SingleByteCP {+ decoderArray = ConvArray "\x0\x0\x1\x0\x2\x0\x3\x0\x4\x0\x5\x0\x6\x0\x7\x0\x8\x0\x9\x0\xa\x0\xb\x0\xc\x0\xd\x0\xe\x0\xf\x0\x10\x0\x11\x0\x12\x0\x13\x0\x14\x0\x15\x0\x16\x0\x17\x0\x18\x0\x19\x0\x1a\x0\x1b\x0\x1c\x0\x1d\x0\x1e\x0\x1f\x0\x20\x0\x21\x0\x22\x0\x23\x0\x24\x0\x25\x0\x26\x0\x27\x0\x28\x0\x29\x0\x2a\x0\x2b\x0\x2c\x0\x2d\x0\x2e\x0\x2f\x0\x30\x0\x31\x0\x32\x0\x33\x0\x34\x0\x35\x0\x36\x0\x37\x0\x38\x0\x39\x0\x3a\x0\x3b\x0\x3c\x0\x3d\x0\x3e\x0\x3f\x0\x40\x0\x41\x0\x42\x0\x43\x0\x44\x0\x45\x0\x46\x0\x47\x0\x48\x0\x49\x0\x4a\x0\x4b\x0\x4c\x0\x4d\x0\x4e\x0\x4f\x0\x50\x0\x51\x0\x52\x0\x53\x0\x54\x0\x55\x0\x56\x0\x57\x0\x58\x0\x59\x0\x5a\x0\x5b\x0\x5c\x0\x5d\x0\x5e\x0\x5f\x0\x60\x0\x61\x0\x62\x0\x63\x0\x64\x0\x65\x0\x66\x0\x67\x0\x68\x0\x69\x0\x6a\x0\x6b\x0\x6c\x0\x6d\x0\x6e\x0\x6f\x0\x70\x0\x71\x0\x72\x0\x73\x0\x74\x0\x75\x0\x76\x0\x77\x0\x78\x0\x79\x0\x7a\x0\x7b\x0\x7c\x0\x7d\x0\x7e\x0\x7f\x0\xc7\x0\xfc\x0\xe9\x0\xe2\x0\xe4\x0\x6f\x1\x7\x1\xe7\x0\x42\x1\xeb\x0\x50\x1\x51\x1\xee\x0\x79\x1\xc4\x0\x6\x1\xc9\x0\x39\x1\x3a\x1\xf4\x0\xf6\x0\x3d\x1\x3e\x1\x5a\x1\x5b\x1\xd6\x0\xdc\x0\x64\x1\x65\x1\x41\x1\xd7\x0\xd\x1\xe1\x0\xed\x0\xf3\x0\xfa\x0\x4\x1\x5\x1\x7d\x1\x7e\x1\x18\x1\x19\x1\xac\x0\x7a\x1\xc\x1\x5f\x1\xab\x0\xbb\x0\x91\x25\x92\x25\x93\x25\x2\x25\x24\x25\xc1\x0\xc2\x0\x1a\x1\x5e\x1\x63\x25\x51\x25\x57\x25\x5d\x25\x7b\x1\x7c\x1\x10\x25\x14\x25\x34\x25\x2c\x25\x1c\x25\x0\x25\x3c\x25\x2\x1\x3\x1\x5a\x25\x54\x25\x69\x25\x66\x25\x60\x25\x50\x25\x6c\x25\xa4\x0\x11\x1\x10\x1\xe\x1\xcb\x0\xf\x1\x47\x1\xcd\x0\xce\x0\x1b\x1\x18\x25\xc\x25\x88\x25\x84\x25\x62\x1\x6e\x1\x80\x25\xd3\x0\xdf\x0\xd4\x0\x43\x1\x44\x1\x48\x1\x60\x1\x61\x1\x54\x1\xda\x0\x55\x1\x70\x1\xfd\x0\xdd\x0\x63\x1\xb4\x0\xad\x0\xdd\x2\xdb\x2\xc7\x2\xd8\x2\xa7\x0\xf7\x0\xb8\x0\xb0\x0\xa8\x0\xd9\x2\x71\x1\x58\x1\x59\x1\xa0\x25\xa0\x0"#+ , encoderArray = + CompactArray {+ encoderIndices = ConvArray "\x0\x0\x40\x0\x80\x0\xc0\x0\x0\x1\x40\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\xc0\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x0\x2\x40\x2\x80\x2"#+ , encoderValues = ConvArray "\x0\x1\x2\x3\x4\x5\x6\x7\x8\x9\xa\xb\xc\xd\xe\xf\x10\x11\x12\x13\x14\x15\x16\x17\x18\x19\x1a\x1b\x1c\x1d\x1e\x1f\x20\x21\x22\x23\x24\x25\x26\x27\x28\x29\x2a\x2b\x2c\x2d\x2e\x2f\x30\x31\x32\x33\x34\x35\x36\x37\x38\x39\x3a\x3b\x3c\x3d\x3e\x3f\x40\x41\x42\x43\x44\x45\x46\x47\x48\x49\x4a\x4b\x4c\x4d\x4e\x4f\x50\x51\x52\x53\x54\x55\x56\x57\x58\x59\x5a\x5b\x5c\x5d\x5e\x5f\x60\x61\x62\x63\x64\x65\x66\x67\x68\x69\x6a\x6b\x6c\x6d\x6e\x6f\x70\x71\x72\x73\x74\x75\x76\x77\x78\x79\x7a\x7b\x7c\x7d\x7e\x7f\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xff\x0\x0\x0\xcf\x0\x0\xf5\xf9\x0\x0\xae\xaa\xf0\x0\x0\xf8\x0\x0\x0\xef\x0\x0\x0\xf7\x0\x0\xaf\x0\x0\x0\x0\x0\xb5\xb6\x0\x8e\x0\x0\x80\x0\x90\x0\xd3\x0\xd6\xd7\x0\x0\x0\x0\xe0\xe2\x0\x99\x9e\x0\x0\xe9\x0\x9a\xed\x0\xe1\x0\xa0\x83\x0\x84\x0\x0\x87\x0\x82\x0\x89\x0\xa1\x8c\x0\x0\x0\x0\xa2\x93\x0\x94\xf6\x0\x0\xa3\x0\x81\xec\x0\x0\x0\x0\xc6\xc7\xa4\xa5\x8f\x86\x0\x0\x0\x0\xac\x9f\xd2\xd4\xd1\xd0\x0\x0\x0\x0\x0\x0\xa8\xa9\xb7\xd8\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x91\x92\x0\x0\x95\x96\x0\x0\x9d\x88\xe3\xe4\x0\x0\xd5\xe5\x0\x0\x0\x0\x0\x0\x0\x8a\x8b\x0\x0\xe8\xea\x0\x0\xfc\xfd\x97\x98\x0\x0\xb8\xad\xe6\xe7\xdd\xee\x9b\x9c\x0\x0\x0\x0\x0\x0\x0\x0\xde\x85\xeb\xfb\x0\x0\x0\x0\x0\x0\x0\x8d\xab\xbd\xbe\xa6\xa7\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xf3\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xf4\xfa\x0\xf2\x0\xf1\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xc4\x0\xb3\x0\x0\x0\x0\x0\x0\x0\x0\x0\xda\x0\x0\x0\xbf\x0\x0\x0\xc0\x0\x0\x0\xd9\x0\x0\x0\xc3\x0\x0\x0\x0\x0\x0\x0\xb4\x0\x0\x0\x0\x0\x0\x0\xc2\x0\x0\x0\x0\x0\x0\x0\xc1\x0\x0\x0\x0\x0\x0\x0\xc5\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xcd\xba\x0\x0\xc9\x0\x0\xbb\x0\x0\xc8\x0\x0\xbc\x0\x0\xcc\x0\x0\xb9\x0\x0\xcb\x0\x0\xca\x0\x0\xce\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xdf\x0\x0\x0\xdc\x0\x0\x0\xdb\x0\x0\x0\x0\x0\x0\x0\x0\xb0\xb1\xb2\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xfe"#+ , encoderMax = '\9632'+ }++ }+ )++ ,+ (855, SingleByteCP {+ decoderArray = ConvArray "\x0\x0\x1\x0\x2\x0\x3\x0\x4\x0\x5\x0\x6\x0\x7\x0\x8\x0\x9\x0\xa\x0\xb\x0\xc\x0\xd\x0\xe\x0\xf\x0\x10\x0\x11\x0\x12\x0\x13\x0\x14\x0\x15\x0\x16\x0\x17\x0\x18\x0\x19\x0\x1a\x0\x1b\x0\x1c\x0\x1d\x0\x1e\x0\x1f\x0\x20\x0\x21\x0\x22\x0\x23\x0\x24\x0\x25\x0\x26\x0\x27\x0\x28\x0\x29\x0\x2a\x0\x2b\x0\x2c\x0\x2d\x0\x2e\x0\x2f\x0\x30\x0\x31\x0\x32\x0\x33\x0\x34\x0\x35\x0\x36\x0\x37\x0\x38\x0\x39\x0\x3a\x0\x3b\x0\x3c\x0\x3d\x0\x3e\x0\x3f\x0\x40\x0\x41\x0\x42\x0\x43\x0\x44\x0\x45\x0\x46\x0\x47\x0\x48\x0\x49\x0\x4a\x0\x4b\x0\x4c\x0\x4d\x0\x4e\x0\x4f\x0\x50\x0\x51\x0\x52\x0\x53\x0\x54\x0\x55\x0\x56\x0\x57\x0\x58\x0\x59\x0\x5a\x0\x5b\x0\x5c\x0\x5d\x0\x5e\x0\x5f\x0\x60\x0\x61\x0\x62\x0\x63\x0\x64\x0\x65\x0\x66\x0\x67\x0\x68\x0\x69\x0\x6a\x0\x6b\x0\x6c\x0\x6d\x0\x6e\x0\x6f\x0\x70\x0\x71\x0\x72\x0\x73\x0\x74\x0\x75\x0\x76\x0\x77\x0\x78\x0\x79\x0\x7a\x0\x7b\x0\x7c\x0\x7d\x0\x7e\x0\x7f\x0\x52\x4\x2\x4\x53\x4\x3\x4\x51\x4\x1\x4\x54\x4\x4\x4\x55\x4\x5\x4\x56\x4\x6\x4\x57\x4\x7\x4\x58\x4\x8\x4\x59\x4\x9\x4\x5a\x4\xa\x4\x5b\x4\xb\x4\x5c\x4\xc\x4\x5e\x4\xe\x4\x5f\x4\xf\x4\x4e\x4\x2e\x4\x4a\x4\x2a\x4\x30\x4\x10\x4\x31\x4\x11\x4\x46\x4\x26\x4\x34\x4\x14\x4\x35\x4\x15\x4\x44\x4\x24\x4\x33\x4\x13\x4\xab\x0\xbb\x0\x91\x25\x92\x25\x93\x25\x2\x25\x24\x25\x45\x4\x25\x4\x38\x4\x18\x4\x63\x25\x51\x25\x57\x25\x5d\x25\x39\x4\x19\x4\x10\x25\x14\x25\x34\x25\x2c\x25\x1c\x25\x0\x25\x3c\x25\x3a\x4\x1a\x4\x5a\x25\x54\x25\x69\x25\x66\x25\x60\x25\x50\x25\x6c\x25\xa4\x0\x3b\x4\x1b\x4\x3c\x4\x1c\x4\x3d\x4\x1d\x4\x3e\x4\x1e\x4\x3f\x4\x18\x25\xc\x25\x88\x25\x84\x25\x1f\x4\x4f\x4\x80\x25\x2f\x4\x40\x4\x20\x4\x41\x4\x21\x4\x42\x4\x22\x4\x43\x4\x23\x4\x36\x4\x16\x4\x32\x4\x12\x4\x4c\x4\x2c\x4\x16\x21\xad\x0\x4b\x4\x2b\x4\x37\x4\x17\x4\x48\x4\x28\x4\x4d\x4\x2d\x4\x49\x4\x29\x4\x47\x4\x27\x4\xa7\x0\xa0\x25\xa0\x0"#+ , encoderArray = + CompactArray {+ encoderIndices = ConvArray "\x0\x0\x40\x0\x80\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\x0\x1\x40\x1\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\x80\x1\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x1\x0\x2\x40\x2"#+ , encoderValues = ConvArray "\x0\x1\x2\x3\x4\x5\x6\x7\x8\x9\xa\xb\xc\xd\xe\xf\x10\x11\x12\x13\x14\x15\x16\x17\x18\x19\x1a\x1b\x1c\x1d\x1e\x1f\x20\x21\x22\x23\x24\x25\x26\x27\x28\x29\x2a\x2b\x2c\x2d\x2e\x2f\x30\x31\x32\x33\x34\x35\x36\x37\x38\x39\x3a\x3b\x3c\x3d\x3e\x3f\x40\x41\x42\x43\x44\x45\x46\x47\x48\x49\x4a\x4b\x4c\x4d\x4e\x4f\x50\x51\x52\x53\x54\x55\x56\x57\x58\x59\x5a\x5b\x5c\x5d\x5e\x5f\x60\x61\x62\x63\x64\x65\x66\x67\x68\x69\x6a\x6b\x6c\x6d\x6e\x6f\x70\x71\x72\x73\x74\x75\x76\x77\x78\x79\x7a\x7b\x7c\x7d\x7e\x7f\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xff\x0\x0\x0\xcf\x0\x0\xfd\x0\x0\x0\xae\x0\xf0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xaf\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x85\x81\x83\x87\x89\x8b\x8d\x8f\x91\x93\x95\x97\x0\x99\x9b\xa1\xa3\xec\xad\xa7\xa9\xea\xf4\xb8\xbe\xc7\xd1\xd3\xd5\xd7\xdd\xe2\xe4\xe6\xe8\xab\xb6\xa5\xfc\xf6\xfa\x9f\xf2\xee\xf8\x9d\xe0\xa0\xa2\xeb\xac\xa6\xa8\xe9\xf3\xb7\xbd\xc6\xd0\xd2\xd4\xd6\xd8\xe1\xe3\xe5\xe7\xaa\xb5\xa4\xfb\xf5\xf9\x9e\xf1\xed\xf7\x9c\xde\x0\x84\x80\x82\x86\x88\x8a\x8c\x8e\x90\x92\x94\x96\x0\x98\x9a\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xef\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xc4\x0\xb3\x0\x0\x0\x0\x0\x0\x0\x0\x0\xda\x0\x0\x0\xbf\x0\x0\x0\xc0\x0\x0\x0\xd9\x0\x0\x0\xc3\x0\x0\x0\x0\x0\x0\x0\xb4\x0\x0\x0\x0\x0\x0\x0\xc2\x0\x0\x0\x0\x0\x0\x0\xc1\x0\x0\x0\x0\x0\x0\x0\xc5\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xcd\xba\x0\x0\xc9\x0\x0\xbb\x0\x0\xc8\x0\x0\xbc\x0\x0\xcc\x0\x0\xb9\x0\x0\xcb\x0\x0\xca\x0\x0\xce\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xdf\x0\x0\x0\xdc\x0\x0\x0\xdb\x0\x0\x0\x0\x0\x0\x0\x0\xb0\xb1\xb2\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xfe"#+ , encoderMax = '\9632'+ }++ }+ )++ ,+ (857, SingleByteCP {+ decoderArray = ConvArray "\x0\x0\x1\x0\x2\x0\x3\x0\x4\x0\x5\x0\x6\x0\x7\x0\x8\x0\x9\x0\xa\x0\xb\x0\xc\x0\xd\x0\xe\x0\xf\x0\x10\x0\x11\x0\x12\x0\x13\x0\x14\x0\x15\x0\x16\x0\x17\x0\x18\x0\x19\x0\x1a\x0\x1b\x0\x1c\x0\x1d\x0\x1e\x0\x1f\x0\x20\x0\x21\x0\x22\x0\x23\x0\x24\x0\x25\x0\x26\x0\x27\x0\x28\x0\x29\x0\x2a\x0\x2b\x0\x2c\x0\x2d\x0\x2e\x0\x2f\x0\x30\x0\x31\x0\x32\x0\x33\x0\x34\x0\x35\x0\x36\x0\x37\x0\x38\x0\x39\x0\x3a\x0\x3b\x0\x3c\x0\x3d\x0\x3e\x0\x3f\x0\x40\x0\x41\x0\x42\x0\x43\x0\x44\x0\x45\x0\x46\x0\x47\x0\x48\x0\x49\x0\x4a\x0\x4b\x0\x4c\x0\x4d\x0\x4e\x0\x4f\x0\x50\x0\x51\x0\x52\x0\x53\x0\x54\x0\x55\x0\x56\x0\x57\x0\x58\x0\x59\x0\x5a\x0\x5b\x0\x5c\x0\x5d\x0\x5e\x0\x5f\x0\x60\x0\x61\x0\x62\x0\x63\x0\x64\x0\x65\x0\x66\x0\x67\x0\x68\x0\x69\x0\x6a\x0\x6b\x0\x6c\x0\x6d\x0\x6e\x0\x6f\x0\x70\x0\x71\x0\x72\x0\x73\x0\x74\x0\x75\x0\x76\x0\x77\x0\x78\x0\x79\x0\x7a\x0\x7b\x0\x7c\x0\x7d\x0\x7e\x0\x7f\x0\xc7\x0\xfc\x0\xe9\x0\xe2\x0\xe4\x0\xe0\x0\xe5\x0\xe7\x0\xea\x0\xeb\x0\xe8\x0\xef\x0\xee\x0\x31\x1\xc4\x0\xc5\x0\xc9\x0\xe6\x0\xc6\x0\xf4\x0\xf6\x0\xf2\x0\xfb\x0\xf9\x0\x30\x1\xd6\x0\xdc\x0\xf8\x0\xa3\x0\xd8\x0\x5e\x1\x5f\x1\xe1\x0\xed\x0\xf3\x0\xfa\x0\xf1\x0\xd1\x0\x1e\x1\x1f\x1\xbf\x0\xae\x0\xac\x0\xbd\x0\xbc\x0\xa1\x0\xab\x0\xbb\x0\x91\x25\x92\x25\x93\x25\x2\x25\x24\x25\xc1\x0\xc2\x0\xc0\x0\xa9\x0\x63\x25\x51\x25\x57\x25\x5d\x25\xa2\x0\xa5\x0\x10\x25\x14\x25\x34\x25\x2c\x25\x1c\x25\x0\x25\x3c\x25\xe3\x0\xc3\x0\x5a\x25\x54\x25\x69\x25\x66\x25\x60\x25\x50\x25\x6c\x25\xa4\x0\xba\x0\xaa\x0\xca\x0\xcb\x0\xc8\x0\x0\x0\xcd\x0\xce\x0\xcf\x0\x18\x25\xc\x25\x88\x25\x84\x25\xa6\x0\xcc\x0\x80\x25\xd3\x0\xdf\x0\xd4\x0\xd2\x0\xf5\x0\xd5\x0\xb5\x0\x0\x0\xd7\x0\xda\x0\xdb\x0\xd9\x0\xec\x0\xff\x0\xaf\x0\xb4\x0\xad\x0\xb1\x0\x0\x0\xbe\x0\xb6\x0\xa7\x0\xf7\x0\xb8\x0\xb0\x0\xa8\x0\xb7\x0\xb9\x0\xb3\x0\xb2\x0\xa0\x25\xa0\x0"#+ , encoderArray = + CompactArray {+ encoderIndices = ConvArray "\x0\x0\x40\x0\x80\x0\xc0\x0\x0\x1\x40\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\xc0\x1\x0\x2\x40\x2"#+ , encoderValues = ConvArray "\x0\x1\x2\x3\x4\x5\x6\x7\x8\x9\xa\xb\xc\xd\xe\xf\x10\x11\x12\x13\x14\x15\x16\x17\x18\x19\x1a\x1b\x1c\x1d\x1e\x1f\x20\x21\x22\x23\x24\x25\x26\x27\x28\x29\x2a\x2b\x2c\x2d\x2e\x2f\x30\x31\x32\x33\x34\x35\x36\x37\x38\x39\x3a\x3b\x3c\x3d\x3e\x3f\x40\x41\x42\x43\x44\x45\x46\x47\x48\x49\x4a\x4b\x4c\x4d\x4e\x4f\x50\x51\x52\x53\x54\x55\x56\x57\x58\x59\x5a\x5b\x5c\x5d\x5e\x5f\x60\x61\x62\x63\x64\x65\x66\x67\x68\x69\x6a\x6b\x6c\x6d\x6e\x6f\x70\x71\x72\x73\x74\x75\x76\x77\x78\x79\x7a\x7b\x7c\x7d\x7e\x7f\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xff\xad\xbd\x9c\xcf\xbe\xdd\xf5\xf9\xb8\xd1\xae\xaa\xf0\xa9\xee\xf8\xf1\xfd\xfc\xef\xe6\xf4\xfa\xf7\xfb\xd0\xaf\xac\xab\xf3\xa8\xb7\xb5\xb6\xc7\x8e\x8f\x92\x80\xd4\x90\xd2\xd3\xde\xd6\xd7\xd8\x0\xa5\xe3\xe0\xe2\xe5\x99\xe8\x9d\xeb\xe9\xea\x9a\x0\x0\xe1\x85\xa0\x83\xc6\x84\x86\x91\x87\x8a\x82\x88\x89\xec\xa1\x8c\x8b\x0\xa4\x95\xa2\x93\xe4\x94\xf6\x9b\x97\xa3\x96\x81\x0\x0\xed\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xa6\xa7\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x98\x8d\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x9e\x9f\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xc4\x0\xb3\x0\x0\x0\x0\x0\x0\x0\x0\x0\xda\x0\x0\x0\xbf\x0\x0\x0\xc0\x0\x0\x0\xd9\x0\x0\x0\xc3\x0\x0\x0\x0\x0\x0\x0\xb4\x0\x0\x0\x0\x0\x0\x0\xc2\x0\x0\x0\x0\x0\x0\x0\xc1\x0\x0\x0\x0\x0\x0\x0\xc5\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xcd\xba\x0\x0\xc9\x0\x0\xbb\x0\x0\xc8\x0\x0\xbc\x0\x0\xcc\x0\x0\xb9\x0\x0\xcb\x0\x0\xca\x0\x0\xce\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xdf\x0\x0\x0\xdc\x0\x0\x0\xdb\x0\x0\x0\x0\x0\x0\x0\x0\xb0\xb1\xb2\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xfe"#+ , encoderMax = '\9632'+ }++ }+ )++ ,+ (860, SingleByteCP {+ decoderArray = ConvArray "\x0\x0\x1\x0\x2\x0\x3\x0\x4\x0\x5\x0\x6\x0\x7\x0\x8\x0\x9\x0\xa\x0\xb\x0\xc\x0\xd\x0\xe\x0\xf\x0\x10\x0\x11\x0\x12\x0\x13\x0\x14\x0\x15\x0\x16\x0\x17\x0\x18\x0\x19\x0\x1a\x0\x1b\x0\x1c\x0\x1d\x0\x1e\x0\x1f\x0\x20\x0\x21\x0\x22\x0\x23\x0\x24\x0\x25\x0\x26\x0\x27\x0\x28\x0\x29\x0\x2a\x0\x2b\x0\x2c\x0\x2d\x0\x2e\x0\x2f\x0\x30\x0\x31\x0\x32\x0\x33\x0\x34\x0\x35\x0\x36\x0\x37\x0\x38\x0\x39\x0\x3a\x0\x3b\x0\x3c\x0\x3d\x0\x3e\x0\x3f\x0\x40\x0\x41\x0\x42\x0\x43\x0\x44\x0\x45\x0\x46\x0\x47\x0\x48\x0\x49\x0\x4a\x0\x4b\x0\x4c\x0\x4d\x0\x4e\x0\x4f\x0\x50\x0\x51\x0\x52\x0\x53\x0\x54\x0\x55\x0\x56\x0\x57\x0\x58\x0\x59\x0\x5a\x0\x5b\x0\x5c\x0\x5d\x0\x5e\x0\x5f\x0\x60\x0\x61\x0\x62\x0\x63\x0\x64\x0\x65\x0\x66\x0\x67\x0\x68\x0\x69\x0\x6a\x0\x6b\x0\x6c\x0\x6d\x0\x6e\x0\x6f\x0\x70\x0\x71\x0\x72\x0\x73\x0\x74\x0\x75\x0\x76\x0\x77\x0\x78\x0\x79\x0\x7a\x0\x7b\x0\x7c\x0\x7d\x0\x7e\x0\x7f\x0\xc7\x0\xfc\x0\xe9\x0\xe2\x0\xe3\x0\xe0\x0\xc1\x0\xe7\x0\xea\x0\xca\x0\xe8\x0\xcd\x0\xd4\x0\xec\x0\xc3\x0\xc2\x0\xc9\x0\xc0\x0\xc8\x0\xf4\x0\xf5\x0\xf2\x0\xda\x0\xf9\x0\xcc\x0\xd5\x0\xdc\x0\xa2\x0\xa3\x0\xd9\x0\xa7\x20\xd3\x0\xe1\x0\xed\x0\xf3\x0\xfa\x0\xf1\x0\xd1\x0\xaa\x0\xba\x0\xbf\x0\xd2\x0\xac\x0\xbd\x0\xbc\x0\xa1\x0\xab\x0\xbb\x0\x91\x25\x92\x25\x93\x25\x2\x25\x24\x25\x61\x25\x62\x25\x56\x25\x55\x25\x63\x25\x51\x25\x57\x25\x5d\x25\x5c\x25\x5b\x25\x10\x25\x14\x25\x34\x25\x2c\x25\x1c\x25\x0\x25\x3c\x25\x5e\x25\x5f\x25\x5a\x25\x54\x25\x69\x25\x66\x25\x60\x25\x50\x25\x6c\x25\x67\x25\x68\x25\x64\x25\x65\x25\x59\x25\x58\x25\x52\x25\x53\x25\x6b\x25\x6a\x25\x18\x25\xc\x25\x88\x25\x84\x25\x8c\x25\x90\x25\x80\x25\xb1\x3\xdf\x0\x93\x3\xc0\x3\xa3\x3\xc3\x3\xb5\x0\xc4\x3\xa6\x3\x98\x3\xa9\x3\xb4\x3\x1e\x22\xc6\x3\xb5\x3\x29\x22\x61\x22\xb1\x0\x65\x22\x64\x22\x20\x23\x21\x23\xf7\x0\x48\x22\xb0\x0\x19\x22\xb7\x0\x1a\x22\x7f\x20\xb2\x0\xa0\x25\xa0\x0"#+ , encoderArray = + CompactArray {+ encoderIndices = ConvArray "\x0\x0\x40\x0\x80\x0\xc0\x0\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x40\x1\x80\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\xc0\x1\x0\x2\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x40\x2\x80\x2\x0\x1\x0\x1\xc0\x2\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x3\x40\x3\x80\x3"#+ , encoderValues = ConvArray "\x0\x1\x2\x3\x4\x5\x6\x7\x8\x9\xa\xb\xc\xd\xe\xf\x10\x11\x12\x13\x14\x15\x16\x17\x18\x19\x1a\x1b\x1c\x1d\x1e\x1f\x20\x21\x22\x23\x24\x25\x26\x27\x28\x29\x2a\x2b\x2c\x2d\x2e\x2f\x30\x31\x32\x33\x34\x35\x36\x37\x38\x39\x3a\x3b\x3c\x3d\x3e\x3f\x40\x41\x42\x43\x44\x45\x46\x47\x48\x49\x4a\x4b\x4c\x4d\x4e\x4f\x50\x51\x52\x53\x54\x55\x56\x57\x58\x59\x5a\x5b\x5c\x5d\x5e\x5f\x60\x61\x62\x63\x64\x65\x66\x67\x68\x69\x6a\x6b\x6c\x6d\x6e\x6f\x70\x71\x72\x73\x74\x75\x76\x77\x78\x79\x7a\x7b\x7c\x7d\x7e\x7f\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xff\xad\x9b\x9c\x0\x0\x0\x0\x0\x0\xa6\xae\xaa\x0\x0\x0\xf8\xf1\xfd\x0\x0\xe6\x0\xfa\x0\x0\xa7\xaf\xac\xab\x0\xa8\x91\x86\x8f\x8e\x0\x0\x0\x80\x92\x90\x89\x0\x98\x8b\x0\x0\x0\xa5\xa9\x9f\x8c\x99\x0\x0\x0\x9d\x96\x0\x9a\x0\x0\xe1\x85\xa0\x83\x84\x0\x0\x0\x87\x8a\x82\x88\x0\x8d\xa1\x0\x0\x0\xa4\x95\xa2\x93\x94\x0\xf6\x0\x97\xa3\x0\x81\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xe2\x0\x0\x0\x0\xe9\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xe4\x0\x0\xe8\x0\x0\xea\x0\x0\x0\x0\x0\x0\x0\xe0\x0\x0\xeb\xee\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xe3\x0\x0\xe5\xe7\x0\xed\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xfc\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x9e\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xf9\xfb\x0\x0\x0\xec\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xef\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xf7\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xf0\x0\x0\xf3\xf2\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xf4\xf5\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xc4\x0\xb3\x0\x0\x0\x0\x0\x0\x0\x0\x0\xda\x0\x0\x0\xbf\x0\x0\x0\xc0\x0\x0\x0\xd9\x0\x0\x0\xc3\x0\x0\x0\x0\x0\x0\x0\xb4\x0\x0\x0\x0\x0\x0\x0\xc2\x0\x0\x0\x0\x0\x0\x0\xc1\x0\x0\x0\x0\x0\x0\x0\xc5\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xcd\xba\xd5\xd6\xc9\xb8\xb7\xbb\xd4\xd3\xc8\xbe\xbd\xbc\xc6\xc7\xcc\xb5\xb6\xb9\xd1\xd2\xcb\xcf\xd0\xca\xd8\xd7\xce\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xdf\x0\x0\x0\xdc\x0\x0\x0\xdb\x0\x0\x0\xdd\x0\x0\x0\xde\xb0\xb1\xb2\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xfe"#+ , encoderMax = '\9632'+ }++ }+ )++ ,+ (861, SingleByteCP {+ decoderArray = ConvArray "\x0\x0\x1\x0\x2\x0\x3\x0\x4\x0\x5\x0\x6\x0\x7\x0\x8\x0\x9\x0\xa\x0\xb\x0\xc\x0\xd\x0\xe\x0\xf\x0\x10\x0\x11\x0\x12\x0\x13\x0\x14\x0\x15\x0\x16\x0\x17\x0\x18\x0\x19\x0\x1a\x0\x1b\x0\x1c\x0\x1d\x0\x1e\x0\x1f\x0\x20\x0\x21\x0\x22\x0\x23\x0\x24\x0\x25\x0\x26\x0\x27\x0\x28\x0\x29\x0\x2a\x0\x2b\x0\x2c\x0\x2d\x0\x2e\x0\x2f\x0\x30\x0\x31\x0\x32\x0\x33\x0\x34\x0\x35\x0\x36\x0\x37\x0\x38\x0\x39\x0\x3a\x0\x3b\x0\x3c\x0\x3d\x0\x3e\x0\x3f\x0\x40\x0\x41\x0\x42\x0\x43\x0\x44\x0\x45\x0\x46\x0\x47\x0\x48\x0\x49\x0\x4a\x0\x4b\x0\x4c\x0\x4d\x0\x4e\x0\x4f\x0\x50\x0\x51\x0\x52\x0\x53\x0\x54\x0\x55\x0\x56\x0\x57\x0\x58\x0\x59\x0\x5a\x0\x5b\x0\x5c\x0\x5d\x0\x5e\x0\x5f\x0\x60\x0\x61\x0\x62\x0\x63\x0\x64\x0\x65\x0\x66\x0\x67\x0\x68\x0\x69\x0\x6a\x0\x6b\x0\x6c\x0\x6d\x0\x6e\x0\x6f\x0\x70\x0\x71\x0\x72\x0\x73\x0\x74\x0\x75\x0\x76\x0\x77\x0\x78\x0\x79\x0\x7a\x0\x7b\x0\x7c\x0\x7d\x0\x7e\x0\x7f\x0\xc7\x0\xfc\x0\xe9\x0\xe2\x0\xe4\x0\xe0\x0\xe5\x0\xe7\x0\xea\x0\xeb\x0\xe8\x0\xd0\x0\xf0\x0\xde\x0\xc4\x0\xc5\x0\xc9\x0\xe6\x0\xc6\x0\xf4\x0\xf6\x0\xfe\x0\xfb\x0\xdd\x0\xfd\x0\xd6\x0\xdc\x0\xf8\x0\xa3\x0\xd8\x0\xa7\x20\x92\x1\xe1\x0\xed\x0\xf3\x0\xfa\x0\xc1\x0\xcd\x0\xd3\x0\xda\x0\xbf\x0\x10\x23\xac\x0\xbd\x0\xbc\x0\xa1\x0\xab\x0\xbb\x0\x91\x25\x92\x25\x93\x25\x2\x25\x24\x25\x61\x25\x62\x25\x56\x25\x55\x25\x63\x25\x51\x25\x57\x25\x5d\x25\x5c\x25\x5b\x25\x10\x25\x14\x25\x34\x25\x2c\x25\x1c\x25\x0\x25\x3c\x25\x5e\x25\x5f\x25\x5a\x25\x54\x25\x69\x25\x66\x25\x60\x25\x50\x25\x6c\x25\x67\x25\x68\x25\x64\x25\x65\x25\x59\x25\x58\x25\x52\x25\x53\x25\x6b\x25\x6a\x25\x18\x25\xc\x25\x88\x25\x84\x25\x8c\x25\x90\x25\x80\x25\xb1\x3\xdf\x0\x93\x3\xc0\x3\xa3\x3\xc3\x3\xb5\x0\xc4\x3\xa6\x3\x98\x3\xa9\x3\xb4\x3\x1e\x22\xc6\x3\xb5\x3\x29\x22\x61\x22\xb1\x0\x65\x22\x64\x22\x20\x23\x21\x23\xf7\x0\x48\x22\xb0\x0\x19\x22\xb7\x0\x1a\x22\x7f\x20\xb2\x0\xa0\x25\xa0\x0"#+ , encoderArray = + CompactArray {+ encoderIndices = ConvArray "\x0\x0\x40\x0\x80\x0\xc0\x0\x0\x1\x0\x1\x40\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x80\x1\xc0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x2\x40\x2\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x80\x2\xc0\x2\x0\x1\x0\x1\x0\x3\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x40\x3\x80\x3\xc0\x3"#+ , encoderValues = ConvArray "\x0\x1\x2\x3\x4\x5\x6\x7\x8\x9\xa\xb\xc\xd\xe\xf\x10\x11\x12\x13\x14\x15\x16\x17\x18\x19\x1a\x1b\x1c\x1d\x1e\x1f\x20\x21\x22\x23\x24\x25\x26\x27\x28\x29\x2a\x2b\x2c\x2d\x2e\x2f\x30\x31\x32\x33\x34\x35\x36\x37\x38\x39\x3a\x3b\x3c\x3d\x3e\x3f\x40\x41\x42\x43\x44\x45\x46\x47\x48\x49\x4a\x4b\x4c\x4d\x4e\x4f\x50\x51\x52\x53\x54\x55\x56\x57\x58\x59\x5a\x5b\x5c\x5d\x5e\x5f\x60\x61\x62\x63\x64\x65\x66\x67\x68\x69\x6a\x6b\x6c\x6d\x6e\x6f\x70\x71\x72\x73\x74\x75\x76\x77\x78\x79\x7a\x7b\x7c\x7d\x7e\x7f\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xff\xad\x0\x9c\x0\x0\x0\x0\x0\x0\x0\xae\xaa\x0\x0\x0\xf8\xf1\xfd\x0\x0\xe6\x0\xfa\x0\x0\x0\xaf\xac\xab\x0\xa8\x0\xa4\x0\x0\x8e\x8f\x92\x80\x0\x90\x0\x0\x0\xa5\x0\x0\x8b\x0\x0\xa6\x0\x0\x99\x0\x9d\x0\xa7\x0\x9a\x97\x8d\xe1\x85\xa0\x83\x0\x84\x86\x91\x87\x8a\x82\x88\x89\x0\xa1\x0\x0\x8c\x0\x0\xa2\x93\x0\x94\xf6\x9b\x0\xa3\x96\x81\x98\x95\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x9f\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xe2\x0\x0\x0\x0\xe9\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xe4\x0\x0\xe8\x0\x0\xea\x0\x0\x0\x0\x0\x0\x0\xe0\x0\x0\xeb\xee\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xe3\x0\x0\xe5\xe7\x0\xed\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xfc\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x9e\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xf9\xfb\x0\x0\x0\xec\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xef\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xf7\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xf0\x0\x0\xf3\xf2\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xa9\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xf4\xf5\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xc4\x0\xb3\x0\x0\x0\x0\x0\x0\x0\x0\x0\xda\x0\x0\x0\xbf\x0\x0\x0\xc0\x0\x0\x0\xd9\x0\x0\x0\xc3\x0\x0\x0\x0\x0\x0\x0\xb4\x0\x0\x0\x0\x0\x0\x0\xc2\x0\x0\x0\x0\x0\x0\x0\xc1\x0\x0\x0\x0\x0\x0\x0\xc5\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xcd\xba\xd5\xd6\xc9\xb8\xb7\xbb\xd4\xd3\xc8\xbe\xbd\xbc\xc6\xc7\xcc\xb5\xb6\xb9\xd1\xd2\xcb\xcf\xd0\xca\xd8\xd7\xce\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xdf\x0\x0\x0\xdc\x0\x0\x0\xdb\x0\x0\x0\xdd\x0\x0\x0\xde\xb0\xb1\xb2\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xfe"#+ , encoderMax = '\9632'+ }++ }+ )++ ,+ (862, SingleByteCP {+ decoderArray = ConvArray "\x0\x0\x1\x0\x2\x0\x3\x0\x4\x0\x5\x0\x6\x0\x7\x0\x8\x0\x9\x0\xa\x0\xb\x0\xc\x0\xd\x0\xe\x0\xf\x0\x10\x0\x11\x0\x12\x0\x13\x0\x14\x0\x15\x0\x16\x0\x17\x0\x18\x0\x19\x0\x1a\x0\x1b\x0\x1c\x0\x1d\x0\x1e\x0\x1f\x0\x20\x0\x21\x0\x22\x0\x23\x0\x24\x0\x25\x0\x26\x0\x27\x0\x28\x0\x29\x0\x2a\x0\x2b\x0\x2c\x0\x2d\x0\x2e\x0\x2f\x0\x30\x0\x31\x0\x32\x0\x33\x0\x34\x0\x35\x0\x36\x0\x37\x0\x38\x0\x39\x0\x3a\x0\x3b\x0\x3c\x0\x3d\x0\x3e\x0\x3f\x0\x40\x0\x41\x0\x42\x0\x43\x0\x44\x0\x45\x0\x46\x0\x47\x0\x48\x0\x49\x0\x4a\x0\x4b\x0\x4c\x0\x4d\x0\x4e\x0\x4f\x0\x50\x0\x51\x0\x52\x0\x53\x0\x54\x0\x55\x0\x56\x0\x57\x0\x58\x0\x59\x0\x5a\x0\x5b\x0\x5c\x0\x5d\x0\x5e\x0\x5f\x0\x60\x0\x61\x0\x62\x0\x63\x0\x64\x0\x65\x0\x66\x0\x67\x0\x68\x0\x69\x0\x6a\x0\x6b\x0\x6c\x0\x6d\x0\x6e\x0\x6f\x0\x70\x0\x71\x0\x72\x0\x73\x0\x74\x0\x75\x0\x76\x0\x77\x0\x78\x0\x79\x0\x7a\x0\x7b\x0\x7c\x0\x7d\x0\x7e\x0\x7f\x0\xd0\x5\xd1\x5\xd2\x5\xd3\x5\xd4\x5\xd5\x5\xd6\x5\xd7\x5\xd8\x5\xd9\x5\xda\x5\xdb\x5\xdc\x5\xdd\x5\xde\x5\xdf\x5\xe0\x5\xe1\x5\xe2\x5\xe3\x5\xe4\x5\xe5\x5\xe6\x5\xe7\x5\xe8\x5\xe9\x5\xea\x5\xa2\x0\xa3\x0\xa5\x0\xa7\x20\x92\x1\xe1\x0\xed\x0\xf3\x0\xfa\x0\xf1\x0\xd1\x0\xaa\x0\xba\x0\xbf\x0\x10\x23\xac\x0\xbd\x0\xbc\x0\xa1\x0\xab\x0\xbb\x0\x91\x25\x92\x25\x93\x25\x2\x25\x24\x25\x61\x25\x62\x25\x56\x25\x55\x25\x63\x25\x51\x25\x57\x25\x5d\x25\x5c\x25\x5b\x25\x10\x25\x14\x25\x34\x25\x2c\x25\x1c\x25\x0\x25\x3c\x25\x5e\x25\x5f\x25\x5a\x25\x54\x25\x69\x25\x66\x25\x60\x25\x50\x25\x6c\x25\x67\x25\x68\x25\x64\x25\x65\x25\x59\x25\x58\x25\x52\x25\x53\x25\x6b\x25\x6a\x25\x18\x25\xc\x25\x88\x25\x84\x25\x8c\x25\x90\x25\x80\x25\xb1\x3\xdf\x0\x93\x3\xc0\x3\xa3\x3\xc3\x3\xb5\x0\xc4\x3\xa6\x3\x98\x3\xa9\x3\xb4\x3\x1e\x22\xc6\x3\xb5\x3\x29\x22\x61\x22\xb1\x0\x65\x22\x64\x22\x20\x23\x21\x23\xf7\x0\x48\x22\xb0\x0\x19\x22\xb7\x0\x1a\x22\x7f\x20\xb2\x0\xa0\x25\xa0\x0"#+ , encoderArray = + CompactArray {+ encoderIndices = ConvArray "\x0\x0\x40\x0\x80\x0\xc0\x0\x0\x1\x0\x1\x40\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x80\x1\xc0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x2\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x40\x2\x80\x2\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\xc0\x2\x0\x3\x0\x1\x0\x1\x40\x3\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x80\x3\xc0\x3\x0\x4"#+ , encoderValues = ConvArray "\x0\x1\x2\x3\x4\x5\x6\x7\x8\x9\xa\xb\xc\xd\xe\xf\x10\x11\x12\x13\x14\x15\x16\x17\x18\x19\x1a\x1b\x1c\x1d\x1e\x1f\x20\x21\x22\x23\x24\x25\x26\x27\x28\x29\x2a\x2b\x2c\x2d\x2e\x2f\x30\x31\x32\x33\x34\x35\x36\x37\x38\x39\x3a\x3b\x3c\x3d\x3e\x3f\x40\x41\x42\x43\x44\x45\x46\x47\x48\x49\x4a\x4b\x4c\x4d\x4e\x4f\x50\x51\x52\x53\x54\x55\x56\x57\x58\x59\x5a\x5b\x5c\x5d\x5e\x5f\x60\x61\x62\x63\x64\x65\x66\x67\x68\x69\x6a\x6b\x6c\x6d\x6e\x6f\x70\x71\x72\x73\x74\x75\x76\x77\x78\x79\x7a\x7b\x7c\x7d\x7e\x7f\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xff\xad\x9b\x9c\x0\x9d\x0\x0\x0\x0\xa6\xae\xaa\x0\x0\x0\xf8\xf1\xfd\x0\x0\xe6\x0\xfa\x0\x0\xa7\xaf\xac\xab\x0\xa8\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xa5\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xe1\x0\xa0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xa1\x0\x0\x0\xa4\x0\xa2\x0\x0\x0\xf6\x0\x0\xa3\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x9f\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xe2\x0\x0\x0\x0\xe9\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xe4\x0\x0\xe8\x0\x0\xea\x0\x0\x0\x0\x0\x0\x0\xe0\x0\x0\xeb\xee\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xe3\x0\x0\xe5\xe7\x0\xed\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x80\x81\x82\x83\x84\x85\x86\x87\x88\x89\x8a\x8b\x8c\x8d\x8e\x8f\x90\x91\x92\x93\x94\x95\x96\x97\x98\x99\x9a\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xfc\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x9e\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xf9\xfb\x0\x0\x0\xec\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xef\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xf7\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xf0\x0\x0\xf3\xf2\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xa9\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xf4\xf5\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xc4\x0\xb3\x0\x0\x0\x0\x0\x0\x0\x0\x0\xda\x0\x0\x0\xbf\x0\x0\x0\xc0\x0\x0\x0\xd9\x0\x0\x0\xc3\x0\x0\x0\x0\x0\x0\x0\xb4\x0\x0\x0\x0\x0\x0\x0\xc2\x0\x0\x0\x0\x0\x0\x0\xc1\x0\x0\x0\x0\x0\x0\x0\xc5\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xcd\xba\xd5\xd6\xc9\xb8\xb7\xbb\xd4\xd3\xc8\xbe\xbd\xbc\xc6\xc7\xcc\xb5\xb6\xb9\xd1\xd2\xcb\xcf\xd0\xca\xd8\xd7\xce\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xdf\x0\x0\x0\xdc\x0\x0\x0\xdb\x0\x0\x0\xdd\x0\x0\x0\xde\xb0\xb1\xb2\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xfe"#+ , encoderMax = '\9632'+ }++ }+ )++ ,+ (863, SingleByteCP {+ decoderArray = ConvArray "\x0\x0\x1\x0\x2\x0\x3\x0\x4\x0\x5\x0\x6\x0\x7\x0\x8\x0\x9\x0\xa\x0\xb\x0\xc\x0\xd\x0\xe\x0\xf\x0\x10\x0\x11\x0\x12\x0\x13\x0\x14\x0\x15\x0\x16\x0\x17\x0\x18\x0\x19\x0\x1a\x0\x1b\x0\x1c\x0\x1d\x0\x1e\x0\x1f\x0\x20\x0\x21\x0\x22\x0\x23\x0\x24\x0\x25\x0\x26\x0\x27\x0\x28\x0\x29\x0\x2a\x0\x2b\x0\x2c\x0\x2d\x0\x2e\x0\x2f\x0\x30\x0\x31\x0\x32\x0\x33\x0\x34\x0\x35\x0\x36\x0\x37\x0\x38\x0\x39\x0\x3a\x0\x3b\x0\x3c\x0\x3d\x0\x3e\x0\x3f\x0\x40\x0\x41\x0\x42\x0\x43\x0\x44\x0\x45\x0\x46\x0\x47\x0\x48\x0\x49\x0\x4a\x0\x4b\x0\x4c\x0\x4d\x0\x4e\x0\x4f\x0\x50\x0\x51\x0\x52\x0\x53\x0\x54\x0\x55\x0\x56\x0\x57\x0\x58\x0\x59\x0\x5a\x0\x5b\x0\x5c\x0\x5d\x0\x5e\x0\x5f\x0\x60\x0\x61\x0\x62\x0\x63\x0\x64\x0\x65\x0\x66\x0\x67\x0\x68\x0\x69\x0\x6a\x0\x6b\x0\x6c\x0\x6d\x0\x6e\x0\x6f\x0\x70\x0\x71\x0\x72\x0\x73\x0\x74\x0\x75\x0\x76\x0\x77\x0\x78\x0\x79\x0\x7a\x0\x7b\x0\x7c\x0\x7d\x0\x7e\x0\x7f\x0\xc7\x0\xfc\x0\xe9\x0\xe2\x0\xc2\x0\xe0\x0\xb6\x0\xe7\x0\xea\x0\xeb\x0\xe8\x0\xef\x0\xee\x0\x17\x20\xc0\x0\xa7\x0\xc9\x0\xc8\x0\xca\x0\xf4\x0\xcb\x0\xcf\x0\xfb\x0\xf9\x0\xa4\x0\xd4\x0\xdc\x0\xa2\x0\xa3\x0\xd9\x0\xdb\x0\x92\x1\xa6\x0\xb4\x0\xf3\x0\xfa\x0\xa8\x0\xb8\x0\xb3\x0\xaf\x0\xce\x0\x10\x23\xac\x0\xbd\x0\xbc\x0\xbe\x0\xab\x0\xbb\x0\x91\x25\x92\x25\x93\x25\x2\x25\x24\x25\x61\x25\x62\x25\x56\x25\x55\x25\x63\x25\x51\x25\x57\x25\x5d\x25\x5c\x25\x5b\x25\x10\x25\x14\x25\x34\x25\x2c\x25\x1c\x25\x0\x25\x3c\x25\x5e\x25\x5f\x25\x5a\x25\x54\x25\x69\x25\x66\x25\x60\x25\x50\x25\x6c\x25\x67\x25\x68\x25\x64\x25\x65\x25\x59\x25\x58\x25\x52\x25\x53\x25\x6b\x25\x6a\x25\x18\x25\xc\x25\x88\x25\x84\x25\x8c\x25\x90\x25\x80\x25\xb1\x3\xdf\x0\x93\x3\xc0\x3\xa3\x3\xc3\x3\xb5\x0\xc4\x3\xa6\x3\x98\x3\xa9\x3\xb4\x3\x1e\x22\xc6\x3\xb5\x3\x29\x22\x61\x22\xb1\x0\x65\x22\x64\x22\x20\x23\x21\x23\xf7\x0\x48\x22\xb0\x0\x19\x22\xb7\x0\x1a\x22\x7f\x20\xb2\x0\xa0\x25\xa0\x0"#+ , encoderArray = + CompactArray {+ encoderIndices = ConvArray "\x0\x0\x40\x0\x80\x0\xc0\x0\x0\x1\x0\x1\x40\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x80\x1\xc0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x2\x40\x2\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x80\x2\xc0\x2\x0\x1\x0\x1\x0\x3\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x40\x3\x80\x3\xc0\x3"#+ , encoderValues = ConvArray "\x0\x1\x2\x3\x4\x5\x6\x7\x8\x9\xa\xb\xc\xd\xe\xf\x10\x11\x12\x13\x14\x15\x16\x17\x18\x19\x1a\x1b\x1c\x1d\x1e\x1f\x20\x21\x22\x23\x24\x25\x26\x27\x28\x29\x2a\x2b\x2c\x2d\x2e\x2f\x30\x31\x32\x33\x34\x35\x36\x37\x38\x39\x3a\x3b\x3c\x3d\x3e\x3f\x40\x41\x42\x43\x44\x45\x46\x47\x48\x49\x4a\x4b\x4c\x4d\x4e\x4f\x50\x51\x52\x53\x54\x55\x56\x57\x58\x59\x5a\x5b\x5c\x5d\x5e\x5f\x60\x61\x62\x63\x64\x65\x66\x67\x68\x69\x6a\x6b\x6c\x6d\x6e\x6f\x70\x71\x72\x73\x74\x75\x76\x77\x78\x79\x7a\x7b\x7c\x7d\x7e\x7f\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xff\x0\x9b\x9c\x98\x0\xa0\x8f\xa4\x0\x0\xae\xaa\x0\x0\xa7\xf8\xf1\xfd\xa6\xa1\xe6\x86\xfa\xa5\x0\x0\xaf\xac\xab\xad\x0\x8e\x0\x84\x0\x0\x0\x0\x80\x91\x90\x92\x94\x0\x0\xa8\x95\x0\x0\x0\x0\x99\x0\x0\x0\x0\x9d\x0\x9e\x9a\x0\x0\xe1\x85\x0\x83\x0\x0\x0\x0\x87\x8a\x82\x88\x89\x0\x0\x8c\x8b\x0\x0\x0\xa2\x93\x0\x0\xf6\x0\x97\xa3\x96\x81\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x9f\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xe2\x0\x0\x0\x0\xe9\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xe4\x0\x0\xe8\x0\x0\xea\x0\x0\x0\x0\x0\x0\x0\xe0\x0\x0\xeb\xee\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xe3\x0\x0\xe5\xe7\x0\xed\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x8d\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xfc\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xf9\xfb\x0\x0\x0\xec\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xef\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xf7\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xf0\x0\x0\xf3\xf2\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xa9\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xf4\xf5\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xc4\x0\xb3\x0\x0\x0\x0\x0\x0\x0\x0\x0\xda\x0\x0\x0\xbf\x0\x0\x0\xc0\x0\x0\x0\xd9\x0\x0\x0\xc3\x0\x0\x0\x0\x0\x0\x0\xb4\x0\x0\x0\x0\x0\x0\x0\xc2\x0\x0\x0\x0\x0\x0\x0\xc1\x0\x0\x0\x0\x0\x0\x0\xc5\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xcd\xba\xd5\xd6\xc9\xb8\xb7\xbb\xd4\xd3\xc8\xbe\xbd\xbc\xc6\xc7\xcc\xb5\xb6\xb9\xd1\xd2\xcb\xcf\xd0\xca\xd8\xd7\xce\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xdf\x0\x0\x0\xdc\x0\x0\x0\xdb\x0\x0\x0\xdd\x0\x0\x0\xde\xb0\xb1\xb2\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xfe"#+ , encoderMax = '\9632'+ }++ }+ )++ ,+ (864, SingleByteCP {+ decoderArray = ConvArray "\x0\x0\x1\x0\x2\x0\x3\x0\x4\x0\x5\x0\x6\x0\x7\x0\x8\x0\x9\x0\xa\x0\xb\x0\xc\x0\xd\x0\xe\x0\xf\x0\x10\x0\x11\x0\x12\x0\x13\x0\x14\x0\x15\x0\x16\x0\x17\x0\x18\x0\x19\x0\x1a\x0\x1b\x0\x1c\x0\x1d\x0\x1e\x0\x1f\x0\x20\x0\x21\x0\x22\x0\x23\x0\x24\x0\x6a\x6\x26\x0\x27\x0\x28\x0\x29\x0\x2a\x0\x2b\x0\x2c\x0\x2d\x0\x2e\x0\x2f\x0\x30\x0\x31\x0\x32\x0\x33\x0\x34\x0\x35\x0\x36\x0\x37\x0\x38\x0\x39\x0\x3a\x0\x3b\x0\x3c\x0\x3d\x0\x3e\x0\x3f\x0\x40\x0\x41\x0\x42\x0\x43\x0\x44\x0\x45\x0\x46\x0\x47\x0\x48\x0\x49\x0\x4a\x0\x4b\x0\x4c\x0\x4d\x0\x4e\x0\x4f\x0\x50\x0\x51\x0\x52\x0\x53\x0\x54\x0\x55\x0\x56\x0\x57\x0\x58\x0\x59\x0\x5a\x0\x5b\x0\x5c\x0\x5d\x0\x5e\x0\x5f\x0\x60\x0\x61\x0\x62\x0\x63\x0\x64\x0\x65\x0\x66\x0\x67\x0\x68\x0\x69\x0\x6a\x0\x6b\x0\x6c\x0\x6d\x0\x6e\x0\x6f\x0\x70\x0\x71\x0\x72\x0\x73\x0\x74\x0\x75\x0\x76\x0\x77\x0\x78\x0\x79\x0\x7a\x0\x7b\x0\x7c\x0\x7d\x0\x7e\x0\x7f\x0\xb0\x0\xb7\x0\x19\x22\x1a\x22\x92\x25\x0\x25\x2\x25\x3c\x25\x24\x25\x2c\x25\x1c\x25\x34\x25\x10\x25\xc\x25\x14\x25\x18\x25\xb2\x3\x1e\x22\xc6\x3\xb1\x0\xbd\x0\xbc\x0\x48\x22\xab\x0\xbb\x0\xf7\xfe\xf8\xfe\x0\x0\x0\x0\xfb\xfe\xfc\xfe\x0\x0\xa0\x0\xad\x0\x82\xfe\xa3\x0\xa4\x0\x84\xfe\x0\x0\x0\x0\x8e\xfe\x8f\xfe\x95\xfe\x99\xfe\xc\x6\x9d\xfe\xa1\xfe\xa5\xfe\x60\x6\x61\x6\x62\x6\x63\x6\x64\x6\x65\x6\x66\x6\x67\x6\x68\x6\x69\x6\xd1\xfe\x1b\x6\xb1\xfe\xb5\xfe\xb9\xfe\x1f\x6\xa2\x0\x80\xfe\x81\xfe\x83\xfe\x85\xfe\xca\xfe\x8b\xfe\x8d\xfe\x91\xfe\x93\xfe\x97\xfe\x9b\xfe\x9f\xfe\xa3\xfe\xa7\xfe\xa9\xfe\xab\xfe\xad\xfe\xaf\xfe\xb3\xfe\xb7\xfe\xbb\xfe\xbf\xfe\xc1\xfe\xc5\xfe\xcb\xfe\xcf\xfe\xa6\x0\xac\x0\xf7\x0\xd7\x0\xc9\xfe\x40\x6\xd3\xfe\xd7\xfe\xdb\xfe\xdf\xfe\xe3\xfe\xe7\xfe\xeb\xfe\xed\xfe\xef\xfe\xf3\xfe\xbd\xfe\xcc\xfe\xce\xfe\xcd\xfe\xe1\xfe\x7d\xfe\x51\x6\xe5\xfe\xe9\xfe\xec\xfe\xf0\xfe\xf2\xfe\xd0\xfe\xd5\xfe\xf5\xfe\xf6\xfe\xdd\xfe\xd9\xfe\xf1\xfe\xa0\x25\x0\x0"#+ , encoderArray = + CompactArray {+ encoderIndices = ConvArray "\x0\x0\x40\x0\x80\x0\xc0\x0\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x40\x1\x80\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\xc0\x1\x0\x2\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x40\x2\x80\x2\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\xc0\x2\x0\x1\x0\x3\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x40\x3\x80\x3\xc0\x3"#+ , encoderValues = ConvArray "\x0\x1\x2\x3\x4\x5\x6\x7\x8\x9\xa\xb\xc\xd\xe\xf\x10\x11\x12\x13\x14\x15\x16\x17\x18\x19\x1a\x1b\x1c\x1d\x1e\x1f\x20\x21\x22\x23\x24\x0\x26\x27\x28\x29\x2a\x2b\x2c\x2d\x2e\x2f\x30\x31\x32\x33\x34\x35\x36\x37\x38\x39\x3a\x3b\x3c\x3d\x3e\x3f\x40\x41\x42\x43\x44\x45\x46\x47\x48\x49\x4a\x4b\x4c\x4d\x4e\x4f\x50\x51\x52\x53\x54\x55\x56\x57\x58\x59\x5a\x5b\x5c\x5d\x5e\x5f\x60\x61\x62\x63\x64\x65\x66\x67\x68\x69\x6a\x6b\x6c\x6d\x6e\x6f\x70\x71\x72\x73\x74\x75\x76\x77\x78\x79\x7a\x7b\x7c\x7d\x7e\x7f\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xa0\x0\xc0\xa3\xa4\x0\xdb\x0\x0\x0\x0\x97\xdc\xa1\x0\x0\x80\x93\x0\x0\x0\x0\x0\x81\x0\x0\x0\x98\x95\x94\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xde\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xdd\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x90\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x92\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xac\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xbb\x0\x0\x0\xbf\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xe0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xf1\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xb0\xb1\xb2\xb3\xb4\xb5\xb6\xb7\xb8\xb9\x25\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x82\x83\x0\x0\x0\x91\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x96\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x85\x0\x86\x0\x0\x0\x0\x0\x0\x0\x0\x0\x8d\x0\x0\x0\x8c\x0\x0\x0\x8e\x0\x0\x0\x8f\x0\x0\x0\x8a\x0\x0\x0\x0\x0\x0\x0\x88\x0\x0\x0\x0\x0\x0\x0\x89\x0\x0\x0\x0\x0\x0\x0\x8b\x0\x0\x0\x0\x0\x0\x0\x87\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x84\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xfe\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xf0\x0\x0\xc1\xc2\xa2\xc3\xa5\xc4\x0\x0\x0\x0\x0\xc6\x0\xc7\xa8\xa9\x0\xc8\x0\xc9\x0\xaa\x0\xca\x0\xab\x0\xcb\x0\xad\x0\xcc\x0\xae\x0\xcd\x0\xaf\x0\xce\x0\xcf\x0\xd0\x0\xd1\x0\xd2\x0\xbc\x0\xd3\x0\xbd\x0\xd4\x0\xbe\x0\xd5\x0\xeb\x0\xd6\x0\xd7\x0\x0\x0\xd8\x0\x0\x0\xdf\xc5\xd9\xec\xee\xed\xda\xf7\xba\x0\xe1\x0\xf8\x0\xe2\x0\xfc\x0\xe3\x0\xfb\x0\xe4\x0\xef\x0\xe5\x0\xf2\x0\xe6\x0\xf3\x0\xe7\xf4\xe8\x0\xe9\xf5\xfd\xf6\xea\x0\xf9\xfa\x99\x9a\x0\x0\x9d\x9e"#+ , encoderMax = '\65276'+ }++ }+ )++ ,+ (865, SingleByteCP {+ decoderArray = ConvArray "\x0\x0\x1\x0\x2\x0\x3\x0\x4\x0\x5\x0\x6\x0\x7\x0\x8\x0\x9\x0\xa\x0\xb\x0\xc\x0\xd\x0\xe\x0\xf\x0\x10\x0\x11\x0\x12\x0\x13\x0\x14\x0\x15\x0\x16\x0\x17\x0\x18\x0\x19\x0\x1a\x0\x1b\x0\x1c\x0\x1d\x0\x1e\x0\x1f\x0\x20\x0\x21\x0\x22\x0\x23\x0\x24\x0\x25\x0\x26\x0\x27\x0\x28\x0\x29\x0\x2a\x0\x2b\x0\x2c\x0\x2d\x0\x2e\x0\x2f\x0\x30\x0\x31\x0\x32\x0\x33\x0\x34\x0\x35\x0\x36\x0\x37\x0\x38\x0\x39\x0\x3a\x0\x3b\x0\x3c\x0\x3d\x0\x3e\x0\x3f\x0\x40\x0\x41\x0\x42\x0\x43\x0\x44\x0\x45\x0\x46\x0\x47\x0\x48\x0\x49\x0\x4a\x0\x4b\x0\x4c\x0\x4d\x0\x4e\x0\x4f\x0\x50\x0\x51\x0\x52\x0\x53\x0\x54\x0\x55\x0\x56\x0\x57\x0\x58\x0\x59\x0\x5a\x0\x5b\x0\x5c\x0\x5d\x0\x5e\x0\x5f\x0\x60\x0\x61\x0\x62\x0\x63\x0\x64\x0\x65\x0\x66\x0\x67\x0\x68\x0\x69\x0\x6a\x0\x6b\x0\x6c\x0\x6d\x0\x6e\x0\x6f\x0\x70\x0\x71\x0\x72\x0\x73\x0\x74\x0\x75\x0\x76\x0\x77\x0\x78\x0\x79\x0\x7a\x0\x7b\x0\x7c\x0\x7d\x0\x7e\x0\x7f\x0\xc7\x0\xfc\x0\xe9\x0\xe2\x0\xe4\x0\xe0\x0\xe5\x0\xe7\x0\xea\x0\xeb\x0\xe8\x0\xef\x0\xee\x0\xec\x0\xc4\x0\xc5\x0\xc9\x0\xe6\x0\xc6\x0\xf4\x0\xf6\x0\xf2\x0\xfb\x0\xf9\x0\xff\x0\xd6\x0\xdc\x0\xf8\x0\xa3\x0\xd8\x0\xa7\x20\x92\x1\xe1\x0\xed\x0\xf3\x0\xfa\x0\xf1\x0\xd1\x0\xaa\x0\xba\x0\xbf\x0\x10\x23\xac\x0\xbd\x0\xbc\x0\xa1\x0\xab\x0\xa4\x0\x91\x25\x92\x25\x93\x25\x2\x25\x24\x25\x61\x25\x62\x25\x56\x25\x55\x25\x63\x25\x51\x25\x57\x25\x5d\x25\x5c\x25\x5b\x25\x10\x25\x14\x25\x34\x25\x2c\x25\x1c\x25\x0\x25\x3c\x25\x5e\x25\x5f\x25\x5a\x25\x54\x25\x69\x25\x66\x25\x60\x25\x50\x25\x6c\x25\x67\x25\x68\x25\x64\x25\x65\x25\x59\x25\x58\x25\x52\x25\x53\x25\x6b\x25\x6a\x25\x18\x25\xc\x25\x88\x25\x84\x25\x8c\x25\x90\x25\x80\x25\xb1\x3\xdf\x0\x93\x3\xc0\x3\xa3\x3\xc3\x3\xb5\x0\xc4\x3\xa6\x3\x98\x3\xa9\x3\xb4\x3\x1e\x22\xc6\x3\xb5\x3\x29\x22\x61\x22\xb1\x0\x65\x22\x64\x22\x20\x23\x21\x23\xf7\x0\x48\x22\xb0\x0\x19\x22\xb7\x0\x1a\x22\x7f\x20\xb2\x0\xa0\x25\xa0\x0"#+ , encoderArray = + CompactArray {+ encoderIndices = ConvArray "\x0\x0\x40\x0\x80\x0\xc0\x0\x0\x1\x0\x1\x40\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x80\x1\xc0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x2\x40\x2\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x80\x2\xc0\x2\x0\x1\x0\x1\x0\x3\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x40\x3\x80\x3\xc0\x3"#+ , encoderValues = ConvArray "\x0\x1\x2\x3\x4\x5\x6\x7\x8\x9\xa\xb\xc\xd\xe\xf\x10\x11\x12\x13\x14\x15\x16\x17\x18\x19\x1a\x1b\x1c\x1d\x1e\x1f\x20\x21\x22\x23\x24\x25\x26\x27\x28\x29\x2a\x2b\x2c\x2d\x2e\x2f\x30\x31\x32\x33\x34\x35\x36\x37\x38\x39\x3a\x3b\x3c\x3d\x3e\x3f\x40\x41\x42\x43\x44\x45\x46\x47\x48\x49\x4a\x4b\x4c\x4d\x4e\x4f\x50\x51\x52\x53\x54\x55\x56\x57\x58\x59\x5a\x5b\x5c\x5d\x5e\x5f\x60\x61\x62\x63\x64\x65\x66\x67\x68\x69\x6a\x6b\x6c\x6d\x6e\x6f\x70\x71\x72\x73\x74\x75\x76\x77\x78\x79\x7a\x7b\x7c\x7d\x7e\x7f\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xff\xad\x0\x9c\xaf\x0\x0\x0\x0\x0\xa6\xae\xaa\x0\x0\x0\xf8\xf1\xfd\x0\x0\xe6\x0\xfa\x0\x0\xa7\x0\xac\xab\x0\xa8\x0\x0\x0\x0\x8e\x8f\x92\x80\x0\x90\x0\x0\x0\x0\x0\x0\x0\xa5\x0\x0\x0\x0\x99\x0\x9d\x0\x0\x0\x9a\x0\x0\xe1\x85\xa0\x83\x0\x84\x86\x91\x87\x8a\x82\x88\x89\x8d\xa1\x8c\x8b\x0\xa4\x95\xa2\x93\x0\x94\xf6\x9b\x97\xa3\x96\x81\x0\x0\x98\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x9f\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xe2\x0\x0\x0\x0\xe9\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xe4\x0\x0\xe8\x0\x0\xea\x0\x0\x0\x0\x0\x0\x0\xe0\x0\x0\xeb\xee\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xe3\x0\x0\xe5\xe7\x0\xed\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xfc\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x9e\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xf9\xfb\x0\x0\x0\xec\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xef\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xf7\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xf0\x0\x0\xf3\xf2\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xa9\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xf4\xf5\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xc4\x0\xb3\x0\x0\x0\x0\x0\x0\x0\x0\x0\xda\x0\x0\x0\xbf\x0\x0\x0\xc0\x0\x0\x0\xd9\x0\x0\x0\xc3\x0\x0\x0\x0\x0\x0\x0\xb4\x0\x0\x0\x0\x0\x0\x0\xc2\x0\x0\x0\x0\x0\x0\x0\xc1\x0\x0\x0\x0\x0\x0\x0\xc5\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xcd\xba\xd5\xd6\xc9\xb8\xb7\xbb\xd4\xd3\xc8\xbe\xbd\xbc\xc6\xc7\xcc\xb5\xb6\xb9\xd1\xd2\xcb\xcf\xd0\xca\xd8\xd7\xce\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xdf\x0\x0\x0\xdc\x0\x0\x0\xdb\x0\x0\x0\xdd\x0\x0\x0\xde\xb0\xb1\xb2\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xfe"#+ , encoderMax = '\9632'+ }++ }+ )++ ,+ (866, SingleByteCP {+ decoderArray = ConvArray "\x0\x0\x1\x0\x2\x0\x3\x0\x4\x0\x5\x0\x6\x0\x7\x0\x8\x0\x9\x0\xa\x0\xb\x0\xc\x0\xd\x0\xe\x0\xf\x0\x10\x0\x11\x0\x12\x0\x13\x0\x14\x0\x15\x0\x16\x0\x17\x0\x18\x0\x19\x0\x1a\x0\x1b\x0\x1c\x0\x1d\x0\x1e\x0\x1f\x0\x20\x0\x21\x0\x22\x0\x23\x0\x24\x0\x25\x0\x26\x0\x27\x0\x28\x0\x29\x0\x2a\x0\x2b\x0\x2c\x0\x2d\x0\x2e\x0\x2f\x0\x30\x0\x31\x0\x32\x0\x33\x0\x34\x0\x35\x0\x36\x0\x37\x0\x38\x0\x39\x0\x3a\x0\x3b\x0\x3c\x0\x3d\x0\x3e\x0\x3f\x0\x40\x0\x41\x0\x42\x0\x43\x0\x44\x0\x45\x0\x46\x0\x47\x0\x48\x0\x49\x0\x4a\x0\x4b\x0\x4c\x0\x4d\x0\x4e\x0\x4f\x0\x50\x0\x51\x0\x52\x0\x53\x0\x54\x0\x55\x0\x56\x0\x57\x0\x58\x0\x59\x0\x5a\x0\x5b\x0\x5c\x0\x5d\x0\x5e\x0\x5f\x0\x60\x0\x61\x0\x62\x0\x63\x0\x64\x0\x65\x0\x66\x0\x67\x0\x68\x0\x69\x0\x6a\x0\x6b\x0\x6c\x0\x6d\x0\x6e\x0\x6f\x0\x70\x0\x71\x0\x72\x0\x73\x0\x74\x0\x75\x0\x76\x0\x77\x0\x78\x0\x79\x0\x7a\x0\x7b\x0\x7c\x0\x7d\x0\x7e\x0\x7f\x0\x10\x4\x11\x4\x12\x4\x13\x4\x14\x4\x15\x4\x16\x4\x17\x4\x18\x4\x19\x4\x1a\x4\x1b\x4\x1c\x4\x1d\x4\x1e\x4\x1f\x4\x20\x4\x21\x4\x22\x4\x23\x4\x24\x4\x25\x4\x26\x4\x27\x4\x28\x4\x29\x4\x2a\x4\x2b\x4\x2c\x4\x2d\x4\x2e\x4\x2f\x4\x30\x4\x31\x4\x32\x4\x33\x4\x34\x4\x35\x4\x36\x4\x37\x4\x38\x4\x39\x4\x3a\x4\x3b\x4\x3c\x4\x3d\x4\x3e\x4\x3f\x4\x91\x25\x92\x25\x93\x25\x2\x25\x24\x25\x61\x25\x62\x25\x56\x25\x55\x25\x63\x25\x51\x25\x57\x25\x5d\x25\x5c\x25\x5b\x25\x10\x25\x14\x25\x34\x25\x2c\x25\x1c\x25\x0\x25\x3c\x25\x5e\x25\x5f\x25\x5a\x25\x54\x25\x69\x25\x66\x25\x60\x25\x50\x25\x6c\x25\x67\x25\x68\x25\x64\x25\x65\x25\x59\x25\x58\x25\x52\x25\x53\x25\x6b\x25\x6a\x25\x18\x25\xc\x25\x88\x25\x84\x25\x8c\x25\x90\x25\x80\x25\x40\x4\x41\x4\x42\x4\x43\x4\x44\x4\x45\x4\x46\x4\x47\x4\x48\x4\x49\x4\x4a\x4\x4b\x4\x4c\x4\x4d\x4\x4e\x4\x4f\x4\x1\x4\x51\x4\x4\x4\x54\x4\x7\x4\x57\x4\xe\x4\x5e\x4\xb0\x0\x19\x22\xb7\x0\x1a\x22\x16\x21\xa4\x0\xa0\x25\xa0\x0"#+ , encoderArray = + CompactArray {+ encoderIndices = ConvArray "\x0\x0\x40\x0\x80\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\x0\x1\x40\x1\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\x80\x1\xc0\x0\xc0\x0\xc0\x0\xc0\x1\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\x0\x2\x40\x2\x80\x2"#+ , encoderValues = ConvArray "\x0\x1\x2\x3\x4\x5\x6\x7\x8\x9\xa\xb\xc\xd\xe\xf\x10\x11\x12\x13\x14\x15\x16\x17\x18\x19\x1a\x1b\x1c\x1d\x1e\x1f\x20\x21\x22\x23\x24\x25\x26\x27\x28\x29\x2a\x2b\x2c\x2d\x2e\x2f\x30\x31\x32\x33\x34\x35\x36\x37\x38\x39\x3a\x3b\x3c\x3d\x3e\x3f\x40\x41\x42\x43\x44\x45\x46\x47\x48\x49\x4a\x4b\x4c\x4d\x4e\x4f\x50\x51\x52\x53\x54\x55\x56\x57\x58\x59\x5a\x5b\x5c\x5d\x5e\x5f\x60\x61\x62\x63\x64\x65\x66\x67\x68\x69\x6a\x6b\x6c\x6d\x6e\x6f\x70\x71\x72\x73\x74\x75\x76\x77\x78\x79\x7a\x7b\x7c\x7d\x7e\x7f\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xff\x0\x0\x0\xfd\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xf8\x0\x0\x0\x0\x0\x0\xfa\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xf0\x0\x0\xf2\x0\x0\xf4\x0\x0\x0\x0\x0\x0\xf6\x0\x80\x81\x82\x83\x84\x85\x86\x87\x88\x89\x8a\x8b\x8c\x8d\x8e\x8f\x90\x91\x92\x93\x94\x95\x96\x97\x98\x99\x9a\x9b\x9c\x9d\x9e\x9f\xa0\xa1\xa2\xa3\xa4\xa5\xa6\xa7\xa8\xa9\xaa\xab\xac\xad\xae\xaf\xe0\xe1\xe2\xe3\xe4\xe5\xe6\xe7\xe8\xe9\xea\xeb\xec\xed\xee\xef\x0\xf1\x0\x0\xf3\x0\x0\xf5\x0\x0\x0\x0\x0\x0\xf7\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xfc\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xf9\xfb\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xc4\x0\xb3\x0\x0\x0\x0\x0\x0\x0\x0\x0\xda\x0\x0\x0\xbf\x0\x0\x0\xc0\x0\x0\x0\xd9\x0\x0\x0\xc3\x0\x0\x0\x0\x0\x0\x0\xb4\x0\x0\x0\x0\x0\x0\x0\xc2\x0\x0\x0\x0\x0\x0\x0\xc1\x0\x0\x0\x0\x0\x0\x0\xc5\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xcd\xba\xd5\xd6\xc9\xb8\xb7\xbb\xd4\xd3\xc8\xbe\xbd\xbc\xc6\xc7\xcc\xb5\xb6\xb9\xd1\xd2\xcb\xcf\xd0\xca\xd8\xd7\xce\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xdf\x0\x0\x0\xdc\x0\x0\x0\xdb\x0\x0\x0\xdd\x0\x0\x0\xde\xb0\xb1\xb2\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xfe"#+ , encoderMax = '\9632'+ }++ }+ )++ ,+ (869, SingleByteCP {+ decoderArray = ConvArray "\x0\x0\x1\x0\x2\x0\x3\x0\x4\x0\x5\x0\x6\x0\x7\x0\x8\x0\x9\x0\xa\x0\xb\x0\xc\x0\xd\x0\xe\x0\xf\x0\x10\x0\x11\x0\x12\x0\x13\x0\x14\x0\x15\x0\x16\x0\x17\x0\x18\x0\x19\x0\x1a\x0\x1b\x0\x1c\x0\x1d\x0\x1e\x0\x1f\x0\x20\x0\x21\x0\x22\x0\x23\x0\x24\x0\x25\x0\x26\x0\x27\x0\x28\x0\x29\x0\x2a\x0\x2b\x0\x2c\x0\x2d\x0\x2e\x0\x2f\x0\x30\x0\x31\x0\x32\x0\x33\x0\x34\x0\x35\x0\x36\x0\x37\x0\x38\x0\x39\x0\x3a\x0\x3b\x0\x3c\x0\x3d\x0\x3e\x0\x3f\x0\x40\x0\x41\x0\x42\x0\x43\x0\x44\x0\x45\x0\x46\x0\x47\x0\x48\x0\x49\x0\x4a\x0\x4b\x0\x4c\x0\x4d\x0\x4e\x0\x4f\x0\x50\x0\x51\x0\x52\x0\x53\x0\x54\x0\x55\x0\x56\x0\x57\x0\x58\x0\x59\x0\x5a\x0\x5b\x0\x5c\x0\x5d\x0\x5e\x0\x5f\x0\x60\x0\x61\x0\x62\x0\x63\x0\x64\x0\x65\x0\x66\x0\x67\x0\x68\x0\x69\x0\x6a\x0\x6b\x0\x6c\x0\x6d\x0\x6e\x0\x6f\x0\x70\x0\x71\x0\x72\x0\x73\x0\x74\x0\x75\x0\x76\x0\x77\x0\x78\x0\x79\x0\x7a\x0\x7b\x0\x7c\x0\x7d\x0\x7e\x0\x7f\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x86\x3\x0\x0\xb7\x0\xac\x0\xa6\x0\x18\x20\x19\x20\x88\x3\x15\x20\x89\x3\x8a\x3\xaa\x3\x8c\x3\x0\x0\x0\x0\x8e\x3\xab\x3\xa9\x0\x8f\x3\xb2\x0\xb3\x0\xac\x3\xa3\x0\xad\x3\xae\x3\xaf\x3\xca\x3\x90\x3\xcc\x3\xcd\x3\x91\x3\x92\x3\x93\x3\x94\x3\x95\x3\x96\x3\x97\x3\xbd\x0\x98\x3\x99\x3\xab\x0\xbb\x0\x91\x25\x92\x25\x93\x25\x2\x25\x24\x25\x9a\x3\x9b\x3\x9c\x3\x9d\x3\x63\x25\x51\x25\x57\x25\x5d\x25\x9e\x3\x9f\x3\x10\x25\x14\x25\x34\x25\x2c\x25\x1c\x25\x0\x25\x3c\x25\xa0\x3\xa1\x3\x5a\x25\x54\x25\x69\x25\x66\x25\x60\x25\x50\x25\x6c\x25\xa3\x3\xa4\x3\xa5\x3\xa6\x3\xa7\x3\xa8\x3\xa9\x3\xb1\x3\xb2\x3\xb3\x3\x18\x25\xc\x25\x88\x25\x84\x25\xb4\x3\xb5\x3\x80\x25\xb6\x3\xb7\x3\xb8\x3\xb9\x3\xba\x3\xbb\x3\xbc\x3\xbd\x3\xbe\x3\xbf\x3\xc0\x3\xc1\x3\xc3\x3\xc2\x3\xc4\x3\x84\x3\xad\x0\xb1\x0\xc5\x3\xc6\x3\xc7\x3\xa7\x0\xc8\x3\x85\x3\xb0\x0\xa8\x0\xc9\x3\xcb\x3\xb0\x3\xce\x3\xa0\x25\xa0\x0"#+ , encoderArray = + CompactArray {+ encoderIndices = ConvArray "\x0\x0\x40\x0\x80\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\x0\x1\x40\x1\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\x80\x1\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x1\x0\x2\x40\x2"#+ , encoderValues = ConvArray "\x0\x1\x2\x3\x4\x5\x6\x7\x8\x9\xa\xb\xc\xd\xe\xf\x10\x11\x12\x13\x14\x15\x16\x17\x18\x19\x1a\x1b\x1c\x1d\x1e\x1f\x20\x21\x22\x23\x24\x25\x26\x27\x28\x29\x2a\x2b\x2c\x2d\x2e\x2f\x30\x31\x32\x33\x34\x35\x36\x37\x38\x39\x3a\x3b\x3c\x3d\x3e\x3f\x40\x41\x42\x43\x44\x45\x46\x47\x48\x49\x4a\x4b\x4c\x4d\x4e\x4f\x50\x51\x52\x53\x54\x55\x56\x57\x58\x59\x5a\x5b\x5c\x5d\x5e\x5f\x60\x61\x62\x63\x64\x65\x66\x67\x68\x69\x6a\x6b\x6c\x6d\x6e\x6f\x70\x71\x72\x73\x74\x75\x76\x77\x78\x79\x7a\x7b\x7c\x7d\x7e\x7f\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xff\x0\x0\x9c\x0\x0\x8a\xf5\xf9\x97\x0\xae\x89\xf0\x0\x0\xf8\xf1\x99\x9a\x0\x0\x0\x88\x0\x0\x0\xaf\x0\xab\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xef\xf7\x86\x0\x8d\x8f\x90\x0\x92\x0\x95\x98\xa1\xa4\xa5\xa6\xa7\xa8\xa9\xaa\xac\xad\xb5\xb6\xb7\xb8\xbd\xbe\xc6\xc7\x0\xcf\xd0\xd1\xd2\xd3\xd4\xd5\x91\x96\x9b\x9d\x9e\x9f\xfc\xd6\xd7\xd8\xdd\xde\xe0\xe1\xe2\xe3\xe4\xe5\xe6\xe7\xe8\xe9\xea\xeb\xed\xec\xee\xf2\xf3\xf4\xf6\xfa\xa0\xfb\xa2\xa3\xfd\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x8e\x0\x0\x8b\x8c\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xc4\x0\xb3\x0\x0\x0\x0\x0\x0\x0\x0\x0\xda\x0\x0\x0\xbf\x0\x0\x0\xc0\x0\x0\x0\xd9\x0\x0\x0\xc3\x0\x0\x0\x0\x0\x0\x0\xb4\x0\x0\x0\x0\x0\x0\x0\xc2\x0\x0\x0\x0\x0\x0\x0\xc1\x0\x0\x0\x0\x0\x0\x0\xc5\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xcd\xba\x0\x0\xc9\x0\x0\xbb\x0\x0\xc8\x0\x0\xbc\x0\x0\xcc\x0\x0\xb9\x0\x0\xcb\x0\x0\xca\x0\x0\xce\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xdf\x0\x0\x0\xdc\x0\x0\x0\xdb\x0\x0\x0\x0\x0\x0\x0\x0\xb0\xb1\xb2\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xfe"#+ , encoderMax = '\9632'+ }++ }+ )++ ,+ (874, SingleByteCP {+ decoderArray = ConvArray "\x0\x0\x1\x0\x2\x0\x3\x0\x4\x0\x5\x0\x6\x0\x7\x0\x8\x0\x9\x0\xa\x0\xb\x0\xc\x0\xd\x0\xe\x0\xf\x0\x10\x0\x11\x0\x12\x0\x13\x0\x14\x0\x15\x0\x16\x0\x17\x0\x18\x0\x19\x0\x1a\x0\x1b\x0\x1c\x0\x1d\x0\x1e\x0\x1f\x0\x20\x0\x21\x0\x22\x0\x23\x0\x24\x0\x25\x0\x26\x0\x27\x0\x28\x0\x29\x0\x2a\x0\x2b\x0\x2c\x0\x2d\x0\x2e\x0\x2f\x0\x30\x0\x31\x0\x32\x0\x33\x0\x34\x0\x35\x0\x36\x0\x37\x0\x38\x0\x39\x0\x3a\x0\x3b\x0\x3c\x0\x3d\x0\x3e\x0\x3f\x0\x40\x0\x41\x0\x42\x0\x43\x0\x44\x0\x45\x0\x46\x0\x47\x0\x48\x0\x49\x0\x4a\x0\x4b\x0\x4c\x0\x4d\x0\x4e\x0\x4f\x0\x50\x0\x51\x0\x52\x0\x53\x0\x54\x0\x55\x0\x56\x0\x57\x0\x58\x0\x59\x0\x5a\x0\x5b\x0\x5c\x0\x5d\x0\x5e\x0\x5f\x0\x60\x0\x61\x0\x62\x0\x63\x0\x64\x0\x65\x0\x66\x0\x67\x0\x68\x0\x69\x0\x6a\x0\x6b\x0\x6c\x0\x6d\x0\x6e\x0\x6f\x0\x70\x0\x71\x0\x72\x0\x73\x0\x74\x0\x75\x0\x76\x0\x77\x0\x78\x0\x79\x0\x7a\x0\x7b\x0\x7c\x0\x7d\x0\x7e\x0\x7f\x0\xac\x20\x0\x0\x0\x0\x0\x0\x0\x0\x26\x20\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x18\x20\x19\x20\x1c\x20\x1d\x20\x22\x20\x13\x20\x14\x20\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xa0\x0\x1\xe\x2\xe\x3\xe\x4\xe\x5\xe\x6\xe\x7\xe\x8\xe\x9\xe\xa\xe\xb\xe\xc\xe\xd\xe\xe\xe\xf\xe\x10\xe\x11\xe\x12\xe\x13\xe\x14\xe\x15\xe\x16\xe\x17\xe\x18\xe\x19\xe\x1a\xe\x1b\xe\x1c\xe\x1d\xe\x1e\xe\x1f\xe\x20\xe\x21\xe\x22\xe\x23\xe\x24\xe\x25\xe\x26\xe\x27\xe\x28\xe\x29\xe\x2a\xe\x2b\xe\x2c\xe\x2d\xe\x2e\xe\x2f\xe\x30\xe\x31\xe\x32\xe\x33\xe\x34\xe\x35\xe\x36\xe\x37\xe\x38\xe\x39\xe\x3a\xe\x0\x0\x0\x0\x0\x0\x0\x0\x3f\xe\x40\xe\x41\xe\x42\xe\x43\xe\x44\xe\x45\xe\x46\xe\x47\xe\x48\xe\x49\xe\x4a\xe\x4b\xe\x4c\xe\x4d\xe\x4e\xe\x4f\xe\x50\xe\x51\xe\x52\xe\x53\xe\x54\xe\x55\xe\x56\xe\x57\xe\x58\xe\x59\xe\x5a\xe\x5b\xe\x0\x0\x0\x0\x0\x0\x0\x0"#+ , encoderArray = + CompactArray {+ encoderIndices = ConvArray "\x0\x0\x40\x0\x80\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\x0\x1\x40\x1\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\x80\x1\xc0\x0\xc0\x1"#+ , encoderValues = ConvArray "\x0\x1\x2\x3\x4\x5\x6\x7\x8\x9\xa\xb\xc\xd\xe\xf\x10\x11\x12\x13\x14\x15\x16\x17\x18\x19\x1a\x1b\x1c\x1d\x1e\x1f\x20\x21\x22\x23\x24\x25\x26\x27\x28\x29\x2a\x2b\x2c\x2d\x2e\x2f\x30\x31\x32\x33\x34\x35\x36\x37\x38\x39\x3a\x3b\x3c\x3d\x3e\x3f\x40\x41\x42\x43\x44\x45\x46\x47\x48\x49\x4a\x4b\x4c\x4d\x4e\x4f\x50\x51\x52\x53\x54\x55\x56\x57\x58\x59\x5a\x5b\x5c\x5d\x5e\x5f\x60\x61\x62\x63\x64\x65\x66\x67\x68\x69\x6a\x6b\x6c\x6d\x6e\x6f\x70\x71\x72\x73\x74\x75\x76\x77\x78\x79\x7a\x7b\x7c\x7d\x7e\x7f\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xa0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xa1\xa2\xa3\xa4\xa5\xa6\xa7\xa8\xa9\xaa\xab\xac\xad\xae\xaf\xb0\xb1\xb2\xb3\xb4\xb5\xb6\xb7\xb8\xb9\xba\xbb\xbc\xbd\xbe\xbf\xc0\xc1\xc2\xc3\xc4\xc5\xc6\xc7\xc8\xc9\xca\xcb\xcc\xcd\xce\xcf\xd0\xd1\xd2\xd3\xd4\xd5\xd6\xd7\xd8\xd9\xda\x0\x0\x0\x0\xdf\xe0\xe1\xe2\xe3\xe4\xe5\xe6\xe7\xe8\xe9\xea\xeb\xec\xed\xee\xef\xf0\xf1\xf2\xf3\xf4\xf5\xf6\xf7\xf8\xf9\xfa\xfb\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x96\x97\x0\x0\x0\x91\x92\x0\x0\x93\x94\x0\x0\x0\x0\x95\x0\x0\x0\x85\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x80"#+ , encoderMax = '\8364'+ }++ }+ )++ ,+ (875, SingleByteCP {+ decoderArray = ConvArray "\x0\x0\x1\x0\x2\x0\x3\x0\x9c\x0\x9\x0\x86\x0\x7f\x0\x97\x0\x8d\x0\x8e\x0\xb\x0\xc\x0\xd\x0\xe\x0\xf\x0\x10\x0\x11\x0\x12\x0\x13\x0\x9d\x0\x85\x0\x8\x0\x87\x0\x18\x0\x19\x0\x92\x0\x8f\x0\x1c\x0\x1d\x0\x1e\x0\x1f\x0\x80\x0\x81\x0\x82\x0\x83\x0\x84\x0\xa\x0\x17\x0\x1b\x0\x88\x0\x89\x0\x8a\x0\x8b\x0\x8c\x0\x5\x0\x6\x0\x7\x0\x90\x0\x91\x0\x16\x0\x93\x0\x94\x0\x95\x0\x96\x0\x4\x0\x98\x0\x99\x0\x9a\x0\x9b\x0\x14\x0\x15\x0\x9e\x0\x1a\x0\x20\x0\x91\x3\x92\x3\x93\x3\x94\x3\x95\x3\x96\x3\x97\x3\x98\x3\x99\x3\x5b\x0\x2e\x0\x3c\x0\x28\x0\x2b\x0\x21\x0\x26\x0\x9a\x3\x9b\x3\x9c\x3\x9d\x3\x9e\x3\x9f\x3\xa0\x3\xa1\x3\xa3\x3\x5d\x0\x24\x0\x2a\x0\x29\x0\x3b\x0\x5e\x0\x2d\x0\x2f\x0\xa4\x3\xa5\x3\xa6\x3\xa7\x3\xa8\x3\xa9\x3\xaa\x3\xab\x3\x7c\x0\x2c\x0\x25\x0\x5f\x0\x3e\x0\x3f\x0\xa8\x0\x86\x3\x88\x3\x89\x3\xa0\x0\x8a\x3\x8c\x3\x8e\x3\x8f\x3\x60\x0\x3a\x0\x23\x0\x40\x0\x27\x0\x3d\x0\x22\x0\x85\x3\x61\x0\x62\x0\x63\x0\x64\x0\x65\x0\x66\x0\x67\x0\x68\x0\x69\x0\xb1\x3\xb2\x3\xb3\x3\xb4\x3\xb5\x3\xb6\x3\xb0\x0\x6a\x0\x6b\x0\x6c\x0\x6d\x0\x6e\x0\x6f\x0\x70\x0\x71\x0\x72\x0\xb7\x3\xb8\x3\xb9\x3\xba\x3\xbb\x3\xbc\x3\xb4\x0\x7e\x0\x73\x0\x74\x0\x75\x0\x76\x0\x77\x0\x78\x0\x79\x0\x7a\x0\xbd\x3\xbe\x3\xbf\x3\xc0\x3\xc1\x3\xc3\x3\xa3\x0\xac\x3\xad\x3\xae\x3\xca\x3\xaf\x3\xcc\x3\xcd\x3\xcb\x3\xce\x3\xc2\x3\xc4\x3\xc5\x3\xc6\x3\xc7\x3\xc8\x3\x7b\x0\x41\x0\x42\x0\x43\x0\x44\x0\x45\x0\x46\x0\x47\x0\x48\x0\x49\x0\xad\x0\xc9\x3\x90\x3\xb0\x3\x18\x20\x15\x20\x7d\x0\x4a\x0\x4b\x0\x4c\x0\x4d\x0\x4e\x0\x4f\x0\x50\x0\x51\x0\x52\x0\xb1\x0\xbd\x0\x1a\x0\x87\x3\x19\x20\xa6\x0\x5c\x0\x1a\x0\x53\x0\x54\x0\x55\x0\x56\x0\x57\x0\x58\x0\x59\x0\x5a\x0\xb2\x0\xa7\x0\x1a\x0\x1a\x0\xab\x0\xac\x0\x30\x0\x31\x0\x32\x0\x33\x0\x34\x0\x35\x0\x36\x0\x37\x0\x38\x0\x39\x0\xb3\x0\xa9\x0\x1a\x0\x1a\x0\xbb\x0\x9f\x0"#+ , encoderArray = + CompactArray {+ encoderIndices = ConvArray "\x0\x0\x40\x0\x80\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\x0\x1\x40\x1\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\x80\x1"#+ , encoderValues = ConvArray "\x0\x1\x2\x3\x37\x2d\x2e\x2f\x16\x5\x25\xb\xc\xd\xe\xf\x10\x11\x12\x13\x3c\x3d\x32\x26\x18\x19\xfd\x27\x1c\x1d\x1e\x1f\x40\x4f\x7f\x7b\x5b\x6c\x50\x7d\x4d\x5d\x5c\x4e\x6b\x60\x4b\x61\xf0\xf1\xf2\xf3\xf4\xf5\xf6\xf7\xf8\xf9\x7a\x5e\x4c\x7e\x6e\x6f\x7c\xc1\xc2\xc3\xc4\xc5\xc6\xc7\xc8\xc9\xd1\xd2\xd3\xd4\xd5\xd6\xd7\xd8\xd9\xe2\xe3\xe4\xe5\xe6\xe7\xe8\xe9\x4a\xe0\x5a\x5f\x6d\x79\x81\x82\x83\x84\x85\x86\x87\x88\x89\x91\x92\x93\x94\x95\x96\x97\x98\x99\xa2\xa3\xa4\xa5\xa6\xa7\xa8\xa9\xc0\x6a\xd0\xa1\x7\x20\x21\x22\x23\x24\x15\x6\x17\x28\x29\x2a\x2b\x2c\x9\xa\x1b\x30\x31\x1a\x33\x34\x35\x36\x8\x38\x39\x3a\x3b\x4\x14\x3e\xff\x74\x0\x0\xb0\x0\x0\xdf\xeb\x70\xfb\x0\xee\xef\xca\x0\x0\x90\xda\xea\xfa\xa0\x0\x0\x0\x0\x0\x0\xfe\x0\xdb\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x80\x71\xdd\x72\x73\x75\x0\x76\x0\x77\x78\xcc\x41\x42\x43\x44\x45\x46\x47\x48\x49\x51\x52\x53\x54\x55\x56\x57\x58\x0\x59\x62\x63\x64\x65\x66\x67\x68\x69\xb1\xb2\xb3\xb5\xcd\x8a\x8b\x8c\x8d\x8e\x8f\x9a\x9b\x9c\x9d\x9e\x9f\xaa\xab\xac\xad\xae\xba\xaf\xbb\xbc\xbd\xbe\xbf\xcb\xb4\xb8\xb6\xb7\xb9\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xcf\x0\x0\xce\xde"#+ , encoderMax = '\8217'+ }++ }+ )+ ]
+ GHC/IO/Encoding/Iconv.hs view
@@ -0,0 +1,227 @@+{-# OPTIONS_GHC -XNoImplicitPrelude #-}+-----------------------------------------------------------------------------+-- |+-- Module : GHC.IO.Encoding.Iconv+-- Copyright : (c) The University of Glasgow, 2008-2009+-- License : see libraries/base/LICENSE+-- +-- Maintainer : libraries@haskell.org+-- Stability : internal+-- Portability : non-portable+--+-- This module provides text encoding/decoding using iconv+--+-----------------------------------------------------------------------------++-- #hide+module GHC.IO.Encoding.Iconv (+#if !defined(mingw32_HOST_OS)+ mkTextEncoding,+ latin1,+ utf8, + utf16, utf16le, utf16be,+ utf32, utf32le, utf32be,+ localeEncoding+#endif+ ) where++#include "MachDeps.h"+#include "HsBaseConfig.h"++#if !defined(mingw32_HOST_OS)++#undef DEBUG_DUMP++import Foreign+import Foreign.C+import Data.Maybe+import GHC.Base+import GHC.IO.Buffer+import GHC.IO.Encoding.Types+import GHC.Num+import GHC.Show+import GHC.Real+#ifdef DEBUG_DUMP+import System.Posix.Internals+#endif++iconv_trace :: String -> IO ()++#ifdef DEBUG_DUMP++iconv_trace s = puts s++puts :: String -> IO ()+puts s = do withCStringLen (s++"\n") $ \(p, len) -> + c_write 1 (castPtr p) (fromIntegral len)+ return ()++#else++iconv_trace _ = return ()++#endif++-- -----------------------------------------------------------------------------+-- iconv encoders/decoders++{-# NOINLINE latin1 #-}+latin1 :: TextEncoding+latin1 = unsafePerformIO (mkTextEncoding "Latin1")++{-# NOINLINE utf8 #-}+utf8 :: TextEncoding+utf8 = unsafePerformIO (mkTextEncoding "UTF8")++{-# NOINLINE utf16 #-}+utf16 :: TextEncoding+utf16 = unsafePerformIO (mkTextEncoding "UTF16")++{-# NOINLINE utf16le #-}+utf16le :: TextEncoding+utf16le = unsafePerformIO (mkTextEncoding "UTF16LE")++{-# NOINLINE utf16be #-}+utf16be :: TextEncoding+utf16be = unsafePerformIO (mkTextEncoding "UTF16BE")++{-# NOINLINE utf32 #-}+utf32 :: TextEncoding+utf32 = unsafePerformIO (mkTextEncoding "UTF32")++{-# NOINLINE utf32le #-}+utf32le :: TextEncoding+utf32le = unsafePerformIO (mkTextEncoding "UTF32LE")++{-# NOINLINE utf32be #-}+utf32be :: TextEncoding+utf32be = unsafePerformIO (mkTextEncoding "UTF32BE")++{-# NOINLINE localeEncoding #-}+localeEncoding :: TextEncoding+localeEncoding = unsafePerformIO $ do+#if HAVE_LANGINFO_H+ cstr <- c_localeEncoding -- use nl_langinfo(CODESET) to get the encoding+ -- if we have it+ r <- peekCString cstr+ mkTextEncoding r+#else+ mkTextEncoding "" -- GNU iconv accepts "" to mean the -- locale encoding.+#endif++-- We hope iconv_t is a storable type. It should be, since it has at least the+-- value -1, which is a possible return value from iconv_open.+type IConv = CLong -- ToDo: (#type iconv_t)++foreign import ccall unsafe "hs_iconv_open"+ hs_iconv_open :: CString -> CString -> IO IConv++foreign import ccall unsafe "hs_iconv_close"+ hs_iconv_close :: IConv -> IO CInt++foreign import ccall unsafe "hs_iconv"+ hs_iconv :: IConv -> Ptr CString -> Ptr CSize -> Ptr CString -> Ptr CSize+ -> IO CSize++foreign import ccall unsafe "localeEncoding"+ c_localeEncoding :: IO CString++haskellChar :: String+#ifdef WORDS_BIGENDIAN+haskellChar | charSize == 2 = "UTF-16BE"+ | otherwise = "UTF-32BE"+#else+haskellChar | charSize == 2 = "UTF-16LE"+ | otherwise = "UTF-32LE"+#endif++char_shift :: Int+char_shift | charSize == 2 = 1+ | otherwise = 2++mkTextEncoding :: String -> IO TextEncoding+mkTextEncoding charset = do+ return (TextEncoding { + mkTextDecoder = newIConv charset haskellChar iconvDecode,+ mkTextEncoder = newIConv haskellChar charset iconvEncode})++newIConv :: String -> String+ -> (IConv -> Buffer a -> Buffer b -> IO (Buffer a, Buffer b))+ -> IO (BufferCodec a b ())+newIConv from to fn =+ withCString from $ \ from_str ->+ withCString to $ \ to_str -> do+ iconvt <- throwErrnoIfMinus1 "mkTextEncoding" $ hs_iconv_open to_str from_str+ let iclose = throwErrnoIfMinus1_ "Iconv.close" $ hs_iconv_close iconvt+ return BufferCodec{+ encode = fn iconvt,+ close = iclose,+ -- iconv doesn't supply a way to save/restore the state+ getState = return (),+ setState = const $ return ()+ }++iconvDecode :: IConv -> Buffer Word8 -> Buffer CharBufElem+ -> IO (Buffer Word8, Buffer CharBufElem)+iconvDecode iconv_t ibuf obuf = iconvRecode iconv_t ibuf 0 obuf char_shift++iconvEncode :: IConv -> Buffer CharBufElem -> Buffer Word8+ -> IO (Buffer CharBufElem, Buffer Word8)+iconvEncode iconv_t ibuf obuf = iconvRecode iconv_t ibuf char_shift obuf 0++iconvRecode :: IConv -> Buffer a -> Int -> Buffer b -> Int + -> IO (Buffer a, Buffer b)+iconvRecode iconv_t+ input@Buffer{ bufRaw=iraw, bufL=ir, bufR=iw, bufSize=_ } iscale+ output@Buffer{ bufRaw=oraw, bufL=_, bufR=ow, bufSize=os } oscale+ = do+ iconv_trace ("haskelChar=" ++ show haskellChar)+ iconv_trace ("iconvRecode before, input=" ++ show (summaryBuffer input))+ iconv_trace ("iconvRecode before, output=" ++ show (summaryBuffer output))+ withRawBuffer iraw $ \ piraw -> do+ withRawBuffer oraw $ \ poraw -> do+ with (piraw `plusPtr` (ir `shiftL` iscale)) $ \ p_inbuf -> do+ with (poraw `plusPtr` (ow `shiftL` oscale)) $ \ p_outbuf -> do+ with (fromIntegral ((iw-ir) `shiftL` iscale)) $ \ p_inleft -> do+ with (fromIntegral ((os-ow) `shiftL` oscale)) $ \ p_outleft -> do+ res <- hs_iconv iconv_t p_inbuf p_inleft p_outbuf p_outleft+ new_inleft <- peek p_inleft+ new_outleft <- peek p_outleft+ let + new_inleft' = fromIntegral new_inleft `shiftR` iscale+ new_outleft' = fromIntegral new_outleft `shiftR` oscale+ new_input + | new_inleft == 0 = input { bufL = 0, bufR = 0 }+ | otherwise = input { bufL = iw - new_inleft' }+ new_output = output{ bufR = os - new_outleft' }+ iconv_trace ("iconv res=" ++ show res)+ iconv_trace ("iconvRecode after, input=" ++ show (summaryBuffer new_input))+ iconv_trace ("iconvRecode after, output=" ++ show (summaryBuffer new_output))+ if (res /= -1)+ then do -- all input translated+ return (new_input, new_output)+ else do+ errno <- getErrno+ case errno of+ e | e == eINVAL + || (e == e2BIG || e == eILSEQ) && new_inleft' /= (iw-ir) -> do+ iconv_trace ("iconv ignoring error: " ++ show (errnoToIOError "iconv" e Nothing Nothing))+ -- Output overflow is relatively harmless, unless+ -- we made no progress at all. + --+ -- Similarly, we ignore EILSEQ unless we converted no+ -- characters. Sometimes iconv reports EILSEQ for a+ -- character in the input even when there is no room+ -- in the output; in this case we might be about to+ -- change the encoding anyway, so the following bytes+ -- could very well be in a different encoding.+ -- This also helps with pinpointing EILSEQ errors: we+ -- don't report it until the rest of the characters in+ -- the buffer have been drained.+ return (new_input, new_output)++ _other -> + throwErrno "iconvRecoder" + -- illegal sequence, or some other error++#endif /* !mingw32_HOST_OS */
+ GHC/IO/Encoding/Latin1.hs view
@@ -0,0 +1,136 @@+{-# OPTIONS_GHC -XNoImplicitPrelude -funbox-strict-fields #-}+{-# LANGUAGE BangPatterns #-}+-----------------------------------------------------------------------------+-- |+-- Module : GHC.IO.Encoding.Latin1+-- 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.Latin1 (+ latin1,+ latin1_checked,+ latin1_decode,+ latin1_encode,+ latin1_checked_encode,+ ) where++import GHC.Base+import GHC.Real+import GHC.Num+-- import GHC.IO+import GHC.IO.Exception+import GHC.IO.Buffer+import GHC.IO.Encoding.Types+import Data.Maybe++-- -----------------------------------------------------------------------------+-- Latin1++latin1 :: TextEncoding+latin1 = TextEncoding { mkTextDecoder = latin1_DF,+ mkTextEncoder = latin1_EF }++latin1_DF :: IO (TextDecoder ())+latin1_DF =+ return (BufferCodec {+ encode = latin1_decode,+ close = return (),+ getState = return (),+ setState = const $ return ()+ })++latin1_EF :: IO (TextEncoder ())+latin1_EF =+ return (BufferCodec {+ encode = latin1_encode,+ close = return (),+ getState = return (),+ setState = const $ return ()+ })++latin1_checked :: TextEncoding+latin1_checked = TextEncoding { mkTextDecoder = latin1_DF,+ mkTextEncoder = latin1_checked_EF }++latin1_checked_EF :: IO (TextEncoder ())+latin1_checked_EF =+ return (BufferCodec {+ encode = latin1_checked_encode,+ close = return (),+ getState = return (),+ setState = const $ return ()+ })+++latin1_decode :: DecodeBuffer+latin1_decode + input@Buffer{ bufRaw=iraw, bufL=ir0, bufR=iw, bufSize=_ }+ output@Buffer{ bufRaw=oraw, bufL=_, bufR=ow0, bufSize=os }+ = let + loop !ir !ow+ | ow >= os || ir >= iw = done ir ow+ | otherwise = do+ c0 <- readWord8Buf iraw ir+ ow' <- writeCharBuf oraw ow (unsafeChr (fromIntegral c0))+ loop (ir+1) ow'++ -- lambda-lifted, to avoid thunks being built in the inner-loop:+ done !ir !ow = return (if ir == iw then input{ bufL=0, bufR=0 }+ else input{ bufL=ir },+ output{ bufR=ow })+ in+ loop ir0 ow0++latin1_encode :: EncodeBuffer+latin1_encode+ input@Buffer{ bufRaw=iraw, bufL=ir0, bufR=iw, bufSize=_ }+ output@Buffer{ bufRaw=oraw, bufL=_, bufR=ow0, bufSize=os }+ = let+ done !ir !ow = return (if ir == iw then input{ bufL=0, bufR=0 }+ else input{ bufL=ir },+ output{ bufR=ow })+ loop !ir !ow+ | ow >= os || ir >= iw = done ir ow+ | otherwise = do+ (c,ir') <- readCharBuf iraw ir+ writeWord8Buf oraw ow (fromIntegral (ord c))+ loop ir' (ow+1)+ in+ loop ir0 ow0++latin1_checked_encode :: EncodeBuffer+latin1_checked_encode+ input@Buffer{ bufRaw=iraw, bufL=ir0, bufR=iw, bufSize=_ }+ output@Buffer{ bufRaw=oraw, bufL=_, bufR=ow0, bufSize=os }+ = let+ done !ir !ow = return (if ir == iw then input{ bufL=0, bufR=0 }+ else input{ bufL=ir },+ output{ bufR=ow })+ loop !ir !ow+ | ow >= os || ir >= iw = done ir ow+ | otherwise = do+ (c,ir') <- readCharBuf iraw ir+ if ord c > 0xff then invalid else do+ writeWord8Buf oraw ow (fromIntegral (ord c))+ loop ir' (ow+1)+ where+ invalid = if ir > ir0 then done ir ow else ioe_encodingError+ in+ loop ir0 ow0++ioe_encodingError :: IO a+ioe_encodingError = ioException+ (IOError Nothing InvalidArgument "latin1_checked_encode"+ "character is out of range for this encoding" Nothing Nothing)
+ GHC/IO/Encoding/Types.hs view
@@ -0,0 +1,89 @@+{-# OPTIONS_GHC -XNoImplicitPrelude -funbox-strict-fields #-}+-----------------------------------------------------------------------------+-- |+-- Module : GHC.IO.Encoding.Types+-- Copyright : (c) The University of Glasgow, 2008-2009+-- License : see libraries/base/LICENSE+-- +-- Maintainer : libraries@haskell.org+-- Stability : internal+-- Portability : non-portable+--+-- Types for text encoding/decoding+--+-----------------------------------------------------------------------------++module GHC.IO.Encoding.Types (+ BufferCodec(..),+ TextEncoding(..),+ TextEncoder, TextDecoder,+ EncodeBuffer, DecodeBuffer,+ ) where++import GHC.Base+import GHC.Word+-- import GHC.IO+import GHC.IO.Buffer++-- -----------------------------------------------------------------------------+-- Text encoders/decoders++data BufferCodec from to state = BufferCodec {+ encode :: Buffer from -> Buffer to -> IO (Buffer from, Buffer to),+ -- ^ The @encode@ function translates elements of the buffer @from@+ -- to the buffer @to@. It should translate as many elements as possible+ -- given the sizes of the buffers, including translating zero elements+ -- if there is either not enough room in @to@, or @from@ does not+ -- contain a complete multibyte sequence.+ -- + -- @encode@ should raise an exception if, and only if, @from@+ -- begins with an illegal sequence, or the first element of @from@+ -- is not representable in the encoding of @to@. That is, if any+ -- elements can be successfully translated before an error is+ -- encountered, then @encode@ should translate as much as it can+ -- and not throw an exception. This behaviour is used by the IO+ -- library in order to report translation errors at the point they+ -- actually occur, rather than when the buffer is translated.+ --+ close :: IO (),+ -- ^ Resources associated with the encoding may now be released.+ -- The @encode@ function may not be called again after calling+ -- @close@.++ getState :: IO state,+ -- ^ Return the current state of the codec.+ --+ -- Many codecs are not stateful, and in these case the state can be+ -- represented as '()'. Other codecs maintain a state. For+ -- example, UTF-16 recognises a BOM (byte-order-mark) character at+ -- the beginning of the input, and remembers thereafter whether to+ -- use big-endian or little-endian mode. In this case, the state+ -- of the codec would include two pieces of information: whether we+ -- are at the beginning of the stream (the BOM only occurs at the+ -- beginning), and if not, whether to use the big or little-endian+ -- encoding.++ setState :: state -> IO()+ -- restore the state of the codec using the state from a previous+ -- call to 'getState'.+ }++type DecodeBuffer = Buffer Word8 -> Buffer Char+ -> IO (Buffer Word8, Buffer Char)++type EncodeBuffer = Buffer Char -> Buffer Word8+ -> IO (Buffer Char, Buffer Word8)++type TextDecoder state = BufferCodec Word8 CharBufElem state+type TextEncoder state = BufferCodec CharBufElem Word8 state++-- | A 'TextEncoding' is a specification of a conversion scheme+-- between sequences of bytes and sequences of Unicode characters.+--+-- For example, UTF-8 is an encoding of Unicode characters into a sequence+-- of bytes. The 'TextEncoding' for UTF-8 is 'utf8'.+data TextEncoding+ = forall dstate estate . TextEncoding {+ mkTextDecoder :: IO (TextDecoder dstate),+ mkTextEncoder :: IO (TextEncoder estate)+ }
+ GHC/IO/Encoding/UTF16.hs view
@@ -0,0 +1,342 @@+{-# OPTIONS_GHC -XNoImplicitPrelude -funbox-strict-fields #-}+{-# LANGUAGE BangPatterns #-}+-----------------------------------------------------------------------------+-- |+-- 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,+ utf16_decode,+ utf16_encode,++ utf16be,+ utf16be_decode,+ utf16be_encode,++ utf16le,+ utf16le_decode,+ utf16le_encode,+ ) where++import GHC.Base+import GHC.Real+import GHC.Num+-- import GHC.IO+import GHC.IO.Exception+import GHC.IO.Buffer+import GHC.IO.Encoding.Types+import GHC.Word+import Data.Bits+import Data.Maybe+import GHC.IORef++#if DEBUG+import System.Posix.Internals+import Foreign.C+import GHC.Show++puts :: String -> IO ()+puts s = do withCStringLen (s++"\n") $ \(p,len) -> + c_write 1 p (fromIntegral len)+ return ()+#endif++-- -----------------------------------------------------------------------------+-- The UTF-16 codec: either UTF16BE or UTF16LE with a BOM++utf16 :: TextEncoding+utf16 = TextEncoding { mkTextDecoder = utf16_DF,+ mkTextEncoder = utf16_EF }++utf16_DF :: IO (TextDecoder (Maybe DecodeBuffer))+utf16_DF = do+ seen_bom <- newIORef Nothing+ return (BufferCodec {+ encode = utf16_decode seen_bom,+ close = return (),+ getState = readIORef seen_bom,+ setState = writeIORef seen_bom+ })++utf16_EF :: IO (TextEncoder Bool)+utf16_EF = do+ done_bom <- newIORef False+ return (BufferCodec {+ encode = utf16_encode done_bom,+ close = return (),+ getState = readIORef done_bom,+ setState = writeIORef done_bom+ })++utf16_encode :: IORef Bool -> EncodeBuffer+utf16_encode done_bom input+ output@Buffer{ bufRaw=oraw, bufL=_, bufR=ow, bufSize=os }+ = do+ b <- readIORef done_bom+ if b then utf16_native_encode input output+ else if os - ow < 2+ then return (input,output)+ else do+ writeIORef done_bom True+ writeWord8Buf oraw ow bom1+ writeWord8Buf oraw (ow+1) bom2+ utf16_native_encode input output{ bufR = ow+2 }++utf16_decode :: IORef (Maybe DecodeBuffer) -> DecodeBuffer+utf16_decode seen_bom+ input@Buffer{ bufRaw=iraw, bufL=ir, bufR=iw, bufSize=_ }+ output+ = do+ mb <- readIORef seen_bom+ case mb of+ Just decode -> decode input output+ Nothing ->+ if iw - ir < 2 then return (input,output) else do+ c0 <- readWord8Buf iraw ir+ c1 <- readWord8Buf iraw (ir+1)+ case () of+ _ | c0 == bomB && c1 == bomL -> do+ writeIORef seen_bom (Just utf16be_decode)+ utf16be_decode input{ bufL= ir+2 } output+ | c0 == bomL && c1 == bomB -> do+ writeIORef seen_bom (Just utf16le_decode)+ utf16le_decode input{ bufL= ir+2 } output+ | otherwise -> do+ writeIORef seen_bom (Just utf16_native_decode)+ utf16_native_decode input output+++bomB, bomL, bom1, bom2 :: Word8+bomB = 0xfe+bomL = 0xff++-- choose UTF-16BE by default for UTF-16 output+utf16_native_decode :: DecodeBuffer+utf16_native_decode = utf16be_decode++utf16_native_encode :: EncodeBuffer+utf16_native_encode = utf16be_encode++bom1 = bomB+bom2 = bomL++-- -----------------------------------------------------------------------------+-- UTF16LE and UTF16BE++utf16be :: TextEncoding+utf16be = TextEncoding { mkTextDecoder = utf16be_DF,+ mkTextEncoder = utf16be_EF }++utf16be_DF :: IO (TextDecoder ())+utf16be_DF =+ return (BufferCodec {+ encode = utf16be_decode,+ close = return (),+ getState = return (),+ setState = const $ return ()+ })++utf16be_EF :: IO (TextEncoder ())+utf16be_EF =+ return (BufferCodec {+ encode = utf16be_encode,+ close = return (),+ getState = return (),+ setState = const $ return ()+ })++utf16le :: TextEncoding+utf16le = TextEncoding { mkTextDecoder = utf16le_DF,+ mkTextEncoder = utf16le_EF }++utf16le_DF :: IO (TextDecoder ())+utf16le_DF =+ return (BufferCodec {+ encode = utf16le_decode,+ close = return (),+ getState = return (),+ setState = const $ return ()+ })++utf16le_EF :: IO (TextEncoder ())+utf16le_EF =+ return (BufferCodec {+ encode = utf16le_encode,+ close = return (),+ getState = return (),+ setState = const $ return ()+ })+++utf16be_decode :: DecodeBuffer+utf16be_decode + input@Buffer{ bufRaw=iraw, bufL=ir0, bufR=iw, bufSize=_ }+ output@Buffer{ bufRaw=oraw, bufL=_, bufR=ow0, bufSize=os }+ = let + loop !ir !ow+ | ow >= os || ir >= iw = done ir ow+ | ir + 1 == iw = done ir ow+ | otherwise = do+ c0 <- readWord8Buf iraw ir+ c1 <- readWord8Buf iraw (ir+1)+ let x1 = fromIntegral c0 `shiftL` 8 + fromIntegral c1+ if validate1 x1+ then do ow' <- writeCharBuf oraw ow (unsafeChr (fromIntegral x1))+ loop (ir+2) ow'+ else if iw - ir < 4 then done ir ow else do+ c2 <- readWord8Buf iraw (ir+2)+ c3 <- readWord8Buf iraw (ir+3)+ let x2 = fromIntegral c2 `shiftL` 8 + fromIntegral c3+ if not (validate2 x1 x2) then invalid else do+ ow' <- writeCharBuf oraw ow (chr2 x1 x2)+ loop (ir+4) ow'+ where+ invalid = if ir > ir0 then done ir ow else ioe_decodingError++ -- lambda-lifted, to avoid thunks being built in the inner-loop:+ done !ir !ow = return (if ir == iw then input{ bufL=0, bufR=0 }+ else input{ bufL=ir },+ output{ bufR=ow })+ in+ loop ir0 ow0++utf16le_decode :: DecodeBuffer+utf16le_decode + input@Buffer{ bufRaw=iraw, bufL=ir0, bufR=iw, bufSize=_ }+ output@Buffer{ bufRaw=oraw, bufL=_, bufR=ow0, bufSize=os }+ = let + loop !ir !ow+ | ow >= os || ir >= iw = done ir ow+ | ir + 1 == iw = done ir ow+ | otherwise = do+ c0 <- readWord8Buf iraw ir+ c1 <- readWord8Buf iraw (ir+1)+ let x1 = fromIntegral c1 `shiftL` 8 + fromIntegral c0+ if validate1 x1+ then do ow' <- writeCharBuf oraw ow (unsafeChr (fromIntegral x1))+ loop (ir+2) ow'+ else if iw - ir < 4 then done ir ow else do+ c2 <- readWord8Buf iraw (ir+2)+ c3 <- readWord8Buf iraw (ir+3)+ let x2 = fromIntegral c3 `shiftL` 8 + fromIntegral c2+ if not (validate2 x1 x2) then invalid else do+ ow' <- writeCharBuf oraw ow (chr2 x1 x2)+ loop (ir+4) ow'+ where+ invalid = if ir > ir0 then done ir ow else ioe_decodingError++ -- lambda-lifted, to avoid thunks being built in the inner-loop:+ done !ir !ow = return (if ir == iw then input{ bufL=0, bufR=0 }+ else input{ bufL=ir },+ output{ bufR=ow })+ in+ loop ir0 ow0++ioe_decodingError :: IO a+ioe_decodingError = ioException+ (IOError Nothing InvalidArgument "utf16_decode"+ "invalid UTF-16 byte sequence" Nothing Nothing)++utf16be_encode :: EncodeBuffer+utf16be_encode+ input@Buffer{ bufRaw=iraw, bufL=ir0, bufR=iw, bufSize=_ }+ output@Buffer{ bufRaw=oraw, bufL=_, bufR=ow0, bufSize=os }+ = let + done !ir !ow = return (if ir == iw then input{ bufL=0, bufR=0 }+ else input{ bufL=ir },+ output{ bufR=ow })+ loop !ir !ow+ | ir >= iw = done ir ow+ | os - ow < 2 = done ir ow+ | otherwise = do+ (c,ir') <- readCharBuf iraw ir+ case ord c of+ x | x < 0x10000 -> do+ writeWord8Buf oraw ow (fromIntegral (x `shiftR` 8))+ writeWord8Buf oraw (ow+1) (fromIntegral x)+ loop ir' (ow+2)+ | otherwise -> do+ if os - ow < 4 then done ir ow else do+ let + n1 = x - 0x10000+ c1 = fromIntegral (n1 `shiftR` 18 + 0xD8)+ c2 = fromIntegral (n1 `shiftR` 10)+ n2 = n1 .&. 0x3FF+ c3 = fromIntegral (n2 `shiftR` 8 + 0xDC)+ c4 = fromIntegral n2+ --+ writeWord8Buf oraw ow c1+ writeWord8Buf oraw (ow+1) c2+ writeWord8Buf oraw (ow+2) c3+ writeWord8Buf oraw (ow+3) c4+ loop ir' (ow+4)+ in+ loop ir0 ow0++utf16le_encode :: EncodeBuffer+utf16le_encode+ input@Buffer{ bufRaw=iraw, bufL=ir0, bufR=iw, bufSize=_ }+ output@Buffer{ bufRaw=oraw, bufL=_, bufR=ow0, bufSize=os }+ = let+ done !ir !ow = return (if ir == iw then input{ bufL=0, bufR=0 }+ else input{ bufL=ir },+ output{ bufR=ow })+ loop !ir !ow+ | ir >= iw = done ir ow+ | os - ow < 2 = done ir ow+ | otherwise = do+ (c,ir') <- readCharBuf iraw ir+ case ord c of+ x | x < 0x10000 -> do+ writeWord8Buf oraw ow (fromIntegral x)+ writeWord8Buf oraw (ow+1) (fromIntegral (x `shiftR` 8))+ loop ir' (ow+2)+ | otherwise ->+ if os - ow < 4 then done ir ow else do+ let + n1 = x - 0x10000+ c1 = fromIntegral (n1 `shiftR` 18 + 0xD8)+ c2 = fromIntegral (n1 `shiftR` 10)+ n2 = n1 .&. 0x3FF+ c3 = fromIntegral (n2 `shiftR` 8 + 0xDC)+ c4 = fromIntegral n2+ --+ writeWord8Buf oraw ow c2+ writeWord8Buf oraw (ow+1) c1+ writeWord8Buf oraw (ow+2) c4+ writeWord8Buf oraw (ow+3) c3+ loop ir' (ow+4)+ in+ loop ir0 ow0++chr2 :: Word16 -> Word16 -> Char+chr2 (W16# a#) (W16# b#) = C# (chr# (upper# +# lower# +# 0x10000#))+ where+ !x# = word2Int# a#+ !y# = word2Int# b#+ !upper# = uncheckedIShiftL# (x# -# 0xD800#) 10#+ !lower# = y# -# 0xDC00#+{-# INLINE chr2 #-}++validate1 :: Word16 -> Bool+validate1 x1 = (x1 >= 0 && x1 < 0xD800) || x1 > 0xDFFF+{-# INLINE validate1 #-}++validate2 :: Word16 -> Word16 -> Bool+validate2 x1 x2 = x1 >= 0xD800 && x1 <= 0xDBFF &&+ x2 >= 0xDC00 && x2 <= 0xDFFF+{-# INLINE validate2 #-}
+ GHC/IO/Encoding/UTF32.hs view
@@ -0,0 +1,306 @@+{-# OPTIONS_GHC -XNoImplicitPrelude -funbox-strict-fields #-}+{-# LANGUAGE BangPatterns #-}+-----------------------------------------------------------------------------+-- |+-- 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,+ utf32_decode,+ utf32_encode,++ utf32be,+ utf32be_decode,+ utf32be_encode,++ utf32le,+ utf32le_decode,+ utf32le_encode,+ ) where++import GHC.Base+import GHC.Real+import GHC.Num+-- import GHC.IO+import GHC.IO.Exception+import GHC.IO.Buffer+import GHC.IO.Encoding.Types+import GHC.Word+import Data.Bits+import Data.Maybe+import GHC.IORef++-- -----------------------------------------------------------------------------+-- The UTF-32 codec: either UTF-32BE or UTF-32LE with a BOM++utf32 :: TextEncoding+utf32 = TextEncoding { mkTextDecoder = utf32_DF,+ mkTextEncoder = utf32_EF }++utf32_DF :: IO (TextDecoder (Maybe DecodeBuffer))+utf32_DF = do+ seen_bom <- newIORef Nothing+ return (BufferCodec {+ encode = utf32_decode seen_bom,+ close = return (),+ getState = readIORef seen_bom,+ setState = writeIORef seen_bom+ })++utf32_EF :: IO (TextEncoder Bool)+utf32_EF = do+ done_bom <- newIORef False+ return (BufferCodec {+ encode = utf32_encode done_bom,+ close = return (),+ getState = readIORef done_bom,+ setState = writeIORef done_bom+ })++utf32_encode :: IORef Bool -> EncodeBuffer+utf32_encode done_bom input+ output@Buffer{ bufRaw=oraw, bufL=_, bufR=ow, bufSize=os }+ = do+ b <- readIORef done_bom+ if b then utf32_native_encode input output+ else if os - ow < 4+ then return (input,output)+ else do+ writeIORef done_bom True+ writeWord8Buf oraw ow bom0+ writeWord8Buf oraw (ow+1) bom1+ writeWord8Buf oraw (ow+2) bom2+ writeWord8Buf oraw (ow+3) bom3+ utf32_native_encode input output{ bufR = ow+4 }++utf32_decode :: IORef (Maybe DecodeBuffer) -> DecodeBuffer+utf32_decode seen_bom+ input@Buffer{ bufRaw=iraw, bufL=ir, bufR=iw, bufSize=_ }+ output+ = do+ mb <- readIORef seen_bom+ case mb of+ Just decode -> decode input output+ Nothing ->+ if iw - ir < 4 then return (input,output) else do+ c0 <- readWord8Buf iraw ir+ c1 <- readWord8Buf iraw (ir+1)+ c2 <- readWord8Buf iraw (ir+2)+ c3 <- readWord8Buf iraw (ir+3)+ case () of+ _ | c0 == bom0 && c1 == bom1 && c2 == bom2 && c3 == bom3 -> do+ writeIORef seen_bom (Just utf32be_decode)+ utf32be_decode input{ bufL= ir+4 } output+ _ | c0 == bom3 && c1 == bom2 && c2 == bom1 && c3 == bom0 -> do+ writeIORef seen_bom (Just utf32le_decode)+ utf32le_decode input{ bufL= ir+4 } output+ | otherwise -> do+ writeIORef seen_bom (Just utf32_native_decode)+ utf32_native_decode input output+++bom0, bom1, bom2, bom3 :: Word8+bom0 = 0+bom1 = 0+bom2 = 0xfe+bom3 = 0xff++-- choose UTF-32BE by default for UTF-32 output+utf32_native_decode :: DecodeBuffer+utf32_native_decode = utf32be_decode++utf32_native_encode :: EncodeBuffer+utf32_native_encode = utf32be_encode++-- -----------------------------------------------------------------------------+-- UTF32LE and UTF32BE++utf32be :: TextEncoding+utf32be = TextEncoding { mkTextDecoder = utf32be_DF,+ mkTextEncoder = utf32be_EF }++utf32be_DF :: IO (TextDecoder ())+utf32be_DF =+ return (BufferCodec {+ encode = utf32be_decode,+ close = return (),+ getState = return (),+ setState = const $ return ()+ })++utf32be_EF :: IO (TextEncoder ())+utf32be_EF =+ return (BufferCodec {+ encode = utf32be_encode,+ close = return (),+ getState = return (),+ setState = const $ return ()+ })+++utf32le :: TextEncoding+utf32le = TextEncoding { mkTextDecoder = utf32le_DF,+ mkTextEncoder = utf32le_EF }++utf32le_DF :: IO (TextDecoder ())+utf32le_DF =+ return (BufferCodec {+ encode = utf32le_decode,+ close = return (),+ getState = return (),+ setState = const $ return ()+ })++utf32le_EF :: IO (TextEncoder ())+utf32le_EF =+ return (BufferCodec {+ encode = utf32le_encode,+ close = return (),+ getState = return (),+ setState = const $ return ()+ })+++utf32be_decode :: DecodeBuffer+utf32be_decode + input@Buffer{ bufRaw=iraw, bufL=ir0, bufR=iw, bufSize=_ }+ output@Buffer{ bufRaw=oraw, bufL=_, bufR=ow0, bufSize=os }+ = let + loop !ir !ow+ | ow >= os || iw - ir < 4 = done ir ow+ | otherwise = do+ c0 <- readWord8Buf iraw ir+ c1 <- readWord8Buf iraw (ir+1)+ c2 <- readWord8Buf iraw (ir+2)+ c3 <- readWord8Buf iraw (ir+3)+ let x1 = chr4 c0 c1 c2 c3+ if not (validate x1) then invalid else do+ ow' <- writeCharBuf oraw ow x1+ loop (ir+4) ow'+ where+ invalid = if ir > ir0 then done ir ow else ioe_decodingError++ -- lambda-lifted, to avoid thunks being built in the inner-loop:+ done !ir !ow = return (if ir == iw then input{ bufL=0, bufR=0 }+ else input{ bufL=ir },+ output{ bufR=ow })+ in+ loop ir0 ow0++utf32le_decode :: DecodeBuffer+utf32le_decode + input@Buffer{ bufRaw=iraw, bufL=ir0, bufR=iw, bufSize=_ }+ output@Buffer{ bufRaw=oraw, bufL=_, bufR=ow0, bufSize=os }+ = let + loop !ir !ow+ | ow >= os || iw - ir < 4 = done ir ow+ | otherwise = do+ c0 <- readWord8Buf iraw ir+ c1 <- readWord8Buf iraw (ir+1)+ c2 <- readWord8Buf iraw (ir+2)+ c3 <- readWord8Buf iraw (ir+3)+ let x1 = chr4 c3 c2 c1 c0+ if not (validate x1) then invalid else do+ ow' <- writeCharBuf oraw ow x1+ loop (ir+4) ow'+ where+ invalid = if ir > ir0 then done ir ow else ioe_decodingError++ -- lambda-lifted, to avoid thunks being built in the inner-loop:+ done !ir !ow = return (if ir == iw then input{ bufL=0, bufR=0 }+ else input{ bufL=ir },+ output{ bufR=ow })+ in+ loop ir0 ow0++ioe_decodingError :: IO a+ioe_decodingError = ioException+ (IOError Nothing InvalidArgument "utf32_decode"+ "invalid UTF-32 byte sequence" Nothing Nothing)++utf32be_encode :: EncodeBuffer+utf32be_encode+ input@Buffer{ bufRaw=iraw, bufL=ir0, bufR=iw, bufSize=_ }+ output@Buffer{ bufRaw=oraw, bufL=_, bufR=ow0, bufSize=os }+ = let + done !ir !ow = return (if ir == iw then input{ bufL=0, bufR=0 }+ else input{ bufL=ir },+ output{ bufR=ow })+ loop !ir !ow+ | ir >= iw = done ir ow+ | os - ow < 4 = done ir ow+ | otherwise = do+ (c,ir') <- readCharBuf iraw ir+ let (c0,c1,c2,c3) = ord4 c+ writeWord8Buf oraw ow c0+ writeWord8Buf oraw (ow+1) c1+ writeWord8Buf oraw (ow+2) c2+ writeWord8Buf oraw (ow+3) c3+ loop ir' (ow+4)+ in+ loop ir0 ow0++utf32le_encode :: EncodeBuffer+utf32le_encode+ input@Buffer{ bufRaw=iraw, bufL=ir0, bufR=iw, bufSize=_ }+ output@Buffer{ bufRaw=oraw, bufL=_, bufR=ow0, bufSize=os }+ = let+ done !ir !ow = return (if ir == iw then input{ bufL=0, bufR=0 }+ else input{ bufL=ir },+ output{ bufR=ow })+ loop !ir !ow+ | ir >= iw = done ir ow+ | os - ow < 4 = done ir ow+ | otherwise = do+ (c,ir') <- readCharBuf iraw ir+ let (c0,c1,c2,c3) = ord4 c+ writeWord8Buf oraw ow c3+ writeWord8Buf oraw (ow+1) c2+ writeWord8Buf oraw (ow+2) c1+ writeWord8Buf oraw (ow+3) c0+ loop ir' (ow+4)+ in+ loop ir0 ow0++chr4 :: Word8 -> Word8 -> Word8 -> Word8 -> Char+chr4 (W8# x1#) (W8# x2#) (W8# x3#) (W8# x4#) =+ C# (chr# (z1# +# z2# +# z3# +# z4#))+ where+ !y1# = word2Int# x1#+ !y2# = word2Int# x2#+ !y3# = word2Int# x3#+ !y4# = word2Int# x4#+ !z1# = uncheckedIShiftL# y1# 24#+ !z2# = uncheckedIShiftL# y2# 16#+ !z3# = uncheckedIShiftL# y3# 8#+ !z4# = y4#+{-# INLINE chr4 #-}++ord4 :: Char -> (Word8,Word8,Word8,Word8)+ord4 c = (fromIntegral (x `shiftR` 24), + fromIntegral (x `shiftR` 16), + fromIntegral (x `shiftR` 8),+ fromIntegral x)+ where+ x = ord c+{-# INLINE ord4 #-}+++validate :: Char -> Bool+validate c = (x1 >= 0x0 && x1 < 0xD800) || (x1 > 0xDFFF && x1 <= 0x10FFFF)+ where x1 = ord c+{-# INLINE validate #-}
+ GHC/IO/Encoding/UTF8.hs view
@@ -0,0 +1,342 @@+{-# OPTIONS_GHC -XNoImplicitPrelude -funbox-strict-fields #-}+{-# LANGUAGE BangPatterns #-}+-----------------------------------------------------------------------------+-- |+-- Module : GHC.IO.Encoding.UTF8+-- Copyright : (c) The University of Glasgow, 2009+-- License : see libraries/base/LICENSE+-- +-- Maintainer : libraries@haskell.org+-- Stability : internal+-- Portability : non-portable+--+-- UTF-8 Codec for the IO library+--+-- Portions Copyright : (c) Tom Harper 2008-2009,+-- (c) Bryan O'Sullivan 2009,+-- (c) Duncan Coutts 2009+--+-----------------------------------------------------------------------------++module GHC.IO.Encoding.UTF8 (+ utf8,+ utf8_bom,+ ) where++import GHC.Base+import GHC.Real+import GHC.Num+import GHC.IORef+-- import GHC.IO+import GHC.IO.Exception+import GHC.IO.Buffer+import GHC.IO.Encoding.Types+import GHC.Word+import Data.Bits+import Data.Maybe++utf8 :: TextEncoding+utf8 = TextEncoding { mkTextDecoder = utf8_DF,+ mkTextEncoder = utf8_EF }++utf8_DF :: IO (TextDecoder ())+utf8_DF =+ return (BufferCodec {+ encode = utf8_decode,+ close = return (),+ getState = return (),+ setState = const $ return ()+ })++utf8_EF :: IO (TextEncoder ())+utf8_EF =+ return (BufferCodec {+ encode = utf8_encode,+ close = return (),+ getState = return (),+ setState = const $ return ()+ })++utf8_bom :: TextEncoding+utf8_bom = TextEncoding { mkTextDecoder = utf8_bom_DF,+ mkTextEncoder = utf8_bom_EF }++utf8_bom_DF :: IO (TextDecoder Bool)+utf8_bom_DF = do+ ref <- newIORef True+ return (BufferCodec {+ encode = utf8_bom_decode ref,+ close = return (),+ getState = readIORef ref,+ setState = writeIORef ref+ })++utf8_bom_EF :: IO (TextEncoder Bool)+utf8_bom_EF = do+ ref <- newIORef True+ return (BufferCodec {+ encode = utf8_bom_encode ref,+ close = return (),+ getState = readIORef ref,+ setState = writeIORef ref+ })++utf8_bom_decode :: IORef Bool -> DecodeBuffer+utf8_bom_decode ref+ input@Buffer{ bufRaw=iraw, bufL=ir, bufR=iw, bufSize=_ }+ output+ = do+ first <- readIORef ref+ if not first+ then utf8_decode input output+ else do+ let no_bom = do writeIORef ref False; utf8_decode input output+ if iw - ir < 1 then return (input,output) else do+ c0 <- readWord8Buf iraw ir+ if (c0 /= bom0) then no_bom else do+ if iw - ir < 2 then return (input,output) else do+ c1 <- readWord8Buf iraw (ir+1)+ if (c1 /= bom1) then no_bom else do+ if iw - ir < 3 then return (input,output) else do+ c2 <- readWord8Buf iraw (ir+2)+ if (c2 /= bom2) then no_bom else do+ -- found a BOM, ignore it and carry on+ writeIORef ref False+ utf8_decode input{ bufL = ir + 3 } output++utf8_bom_encode :: IORef Bool -> EncodeBuffer+utf8_bom_encode ref input+ output@Buffer{ bufRaw=oraw, bufL=_, bufR=ow, bufSize=os }+ = do+ b <- readIORef ref+ if not b then utf8_encode input output+ else if os - ow < 3+ then return (input,output)+ else do+ writeIORef ref False+ writeWord8Buf oraw ow bom0+ writeWord8Buf oraw (ow+1) bom1+ writeWord8Buf oraw (ow+2) bom2+ utf8_encode input output{ bufR = ow+3 }++bom0, bom1, bom2 :: Word8+bom0 = 0xef+bom1 = 0xbb+bom2 = 0xbf++utf8_decode :: DecodeBuffer+utf8_decode + input@Buffer{ bufRaw=iraw, bufL=ir0, bufR=iw, bufSize=_ }+ output@Buffer{ bufRaw=oraw, bufL=_, bufR=ow0, bufSize=os }+ = let + loop !ir !ow+ | ow >= os || ir >= iw = done ir ow+ | otherwise = do+ c0 <- readWord8Buf iraw ir+ case c0 of+ _ | c0 <= 0x7f -> do + ow' <- writeCharBuf oraw ow (unsafeChr (fromIntegral c0))+ loop (ir+1) ow'+ | c0 >= 0xc0 && c0 <= 0xdf ->+ if iw - ir < 2 then done ir ow else do+ c1 <- readWord8Buf iraw (ir+1)+ if (c1 < 0x80 || c1 >= 0xc0) then invalid else do+ ow' <- writeCharBuf oraw ow (chr2 c0 c1)+ loop (ir+2) ow'+ | c0 >= 0xe0 && c0 <= 0xef ->+ case iw - ir of+ 1 -> done ir ow+ 2 -> do -- check for an error even when we don't have+ -- the full sequence yet (#3341)+ c1 <- readWord8Buf iraw (ir+1)+ if not (validate3 c0 c1 0x80) + then invalid else done ir ow+ _ -> do+ c1 <- readWord8Buf iraw (ir+1)+ c2 <- readWord8Buf iraw (ir+2)+ if not (validate3 c0 c1 c2) then invalid else do+ ow' <- writeCharBuf oraw ow (chr3 c0 c1 c2)+ loop (ir+3) ow'+ | c0 >= 0xf0 ->+ case iw - ir of+ 1 -> done ir ow+ 2 -> do -- check for an error even when we don't have+ -- the full sequence yet (#3341)+ c1 <- readWord8Buf iraw (ir+1)+ if not (validate4 c0 c1 0x80 0x80)+ then invalid else done ir ow+ 3 -> do+ c1 <- readWord8Buf iraw (ir+1)+ c2 <- readWord8Buf iraw (ir+2)+ if not (validate4 c0 c1 c2 0x80)+ then invalid else done ir ow+ _ -> do+ c1 <- readWord8Buf iraw (ir+1)+ c2 <- readWord8Buf iraw (ir+2)+ c3 <- readWord8Buf iraw (ir+3)+ if not (validate4 c0 c1 c2 c3) then invalid else do+ ow' <- writeCharBuf oraw ow (chr4 c0 c1 c2 c3)+ loop (ir+4) ow'+ | otherwise ->+ invalid+ where+ invalid = if ir > ir0 then done ir ow else ioe_decodingError++ -- lambda-lifted, to avoid thunks being built in the inner-loop:+ done !ir !ow = return (if ir == iw then input{ bufL=0, bufR=0 }+ else input{ bufL=ir },+ output{ bufR=ow })+ in+ loop ir0 ow0++ioe_decodingError :: IO a+ioe_decodingError = ioException+ (IOError Nothing InvalidArgument "utf8_decode"+ "invalid UTF-8 byte sequence" Nothing Nothing)++utf8_encode :: EncodeBuffer+utf8_encode+ input@Buffer{ bufRaw=iraw, bufL=ir0, bufR=iw, bufSize=_ }+ output@Buffer{ bufRaw=oraw, bufL=_, bufR=ow0, bufSize=os }+ = let + done !ir !ow = return (if ir == iw then input{ bufL=0, bufR=0 }+ else input{ bufL=ir },+ output{ bufR=ow })+ loop !ir !ow+ | ow >= os || ir >= iw = done ir ow+ | otherwise = do+ (c,ir') <- readCharBuf iraw ir+ case ord c of+ x | x <= 0x7F -> do+ writeWord8Buf oraw ow (fromIntegral x)+ loop ir' (ow+1)+ | x <= 0x07FF ->+ if os - ow < 2 then done ir ow else do+ let (c1,c2) = ord2 c+ writeWord8Buf oraw ow c1+ writeWord8Buf oraw (ow+1) c2+ loop ir' (ow+2)+ | x <= 0xFFFF -> do+ if os - ow < 3 then done ir ow else do+ let (c1,c2,c3) = ord3 c+ writeWord8Buf oraw ow c1+ writeWord8Buf oraw (ow+1) c2+ writeWord8Buf oraw (ow+2) c3+ loop ir' (ow+3)+ | otherwise -> do+ if os - ow < 4 then done ir ow else do+ let (c1,c2,c3,c4) = ord4 c+ writeWord8Buf oraw ow c1+ writeWord8Buf oraw (ow+1) c2+ writeWord8Buf oraw (ow+2) c3+ writeWord8Buf oraw (ow+3) c4+ loop ir' (ow+4)+ in+ loop ir0 ow0++-- -----------------------------------------------------------------------------+-- UTF-8 primitives, lifted from Data.Text.Fusion.Utf8+ +ord2 :: Char -> (Word8,Word8)+ord2 c = assert (n >= 0x80 && n <= 0x07ff) (x1,x2)+ where+ n = ord c+ x1 = fromIntegral $ (n `shiftR` 6) + 0xC0+ x2 = fromIntegral $ (n .&. 0x3F) + 0x80++ord3 :: Char -> (Word8,Word8,Word8)+ord3 c = assert (n >= 0x0800 && n <= 0xffff) (x1,x2,x3)+ where+ n = ord c+ x1 = fromIntegral $ (n `shiftR` 12) + 0xE0+ x2 = fromIntegral $ ((n `shiftR` 6) .&. 0x3F) + 0x80+ x3 = fromIntegral $ (n .&. 0x3F) + 0x80++ord4 :: Char -> (Word8,Word8,Word8,Word8)+ord4 c = assert (n >= 0x10000) (x1,x2,x3,x4)+ where+ n = ord c+ x1 = fromIntegral $ (n `shiftR` 18) + 0xF0+ x2 = fromIntegral $ ((n `shiftR` 12) .&. 0x3F) + 0x80+ x3 = fromIntegral $ ((n `shiftR` 6) .&. 0x3F) + 0x80+ x4 = fromIntegral $ (n .&. 0x3F) + 0x80++chr2 :: Word8 -> Word8 -> Char+chr2 (W8# x1#) (W8# x2#) = C# (chr# (z1# +# z2#))+ where+ !y1# = word2Int# x1#+ !y2# = word2Int# x2#+ !z1# = uncheckedIShiftL# (y1# -# 0xC0#) 6#+ !z2# = y2# -# 0x80#+{-# INLINE chr2 #-}++chr3 :: Word8 -> Word8 -> Word8 -> Char+chr3 (W8# x1#) (W8# x2#) (W8# x3#) = C# (chr# (z1# +# z2# +# z3#))+ where+ !y1# = word2Int# x1#+ !y2# = word2Int# x2#+ !y3# = word2Int# x3#+ !z1# = uncheckedIShiftL# (y1# -# 0xE0#) 12#+ !z2# = uncheckedIShiftL# (y2# -# 0x80#) 6#+ !z3# = y3# -# 0x80#+{-# INLINE chr3 #-}++chr4 :: Word8 -> Word8 -> Word8 -> Word8 -> Char+chr4 (W8# x1#) (W8# x2#) (W8# x3#) (W8# x4#) =+ C# (chr# (z1# +# z2# +# z3# +# z4#))+ where+ !y1# = word2Int# x1#+ !y2# = word2Int# x2#+ !y3# = word2Int# x3#+ !y4# = word2Int# x4#+ !z1# = uncheckedIShiftL# (y1# -# 0xF0#) 18#+ !z2# = uncheckedIShiftL# (y2# -# 0x80#) 12#+ !z3# = uncheckedIShiftL# (y3# -# 0x80#) 6#+ !z4# = y4# -# 0x80#+{-# INLINE chr4 #-}++between :: Word8 -- ^ byte to check+ -> Word8 -- ^ lower bound+ -> Word8 -- ^ upper bound+ -> Bool+between x y z = x >= y && x <= z+{-# INLINE between #-}++validate3 :: Word8 -> Word8 -> Word8 -> Bool+{-# INLINE validate3 #-}+validate3 x1 x2 x3 = validate3_1 ||+ validate3_2 ||+ validate3_3 ||+ validate3_4+ where+ validate3_1 = (x1 == 0xE0) &&+ between x2 0xA0 0xBF &&+ between x3 0x80 0xBF+ validate3_2 = between x1 0xE1 0xEC &&+ between x2 0x80 0xBF &&+ between x3 0x80 0xBF+ validate3_3 = x1 == 0xED &&+ between x2 0x80 0x9F &&+ between x3 0x80 0xBF+ validate3_4 = between x1 0xEE 0xEF &&+ between x2 0x80 0xBF &&+ between x3 0x80 0xBF++validate4 :: Word8 -> Word8 -> Word8 -> Word8 -> Bool+{-# INLINE validate4 #-}+validate4 x1 x2 x3 x4 = validate4_1 ||+ validate4_2 ||+ validate4_3+ where + validate4_1 = x1 == 0xF0 &&+ between x2 0x90 0xBF &&+ between x3 0x80 0xBF &&+ between x4 0x80 0xBF+ validate4_2 = between x1 0xF1 0xF3 &&+ between x2 0x80 0xBF &&+ between x3 0x80 0xBF &&+ between x4 0x80 0xBF+ validate4_3 = x1 == 0xF4 &&+ between x2 0x80 0x8F &&+ between x3 0x80 0xBF &&+ between x4 0x80 0xBF
+ GHC/IO/Exception.hs view
@@ -0,0 +1,336 @@+{-# OPTIONS_GHC -XNoImplicitPrelude -funbox-strict-fields #-}+{-# OPTIONS_HADDOCK hide #-}+-----------------------------------------------------------------------------+-- |+-- Module : GHC.IO.Exception+-- Copyright : (c) The University of Glasgow, 2009+-- License : see libraries/base/LICENSE+-- +-- Maintainer : libraries@haskell.org+-- Stability : internal+-- Portability : non-portable+--+-- IO-related Exception types and functions+--+-----------------------------------------------------------------------------++module GHC.IO.Exception (+ BlockedIndefinitelyOnMVar(..), blockedIndefinitelyOnMVar,+ BlockedIndefinitelyOnSTM(..), blockedIndefinitelyOnSTM,+ Deadlock(..),+ AssertionFailed(..),+ AsyncException(..), stackOverflow, heapOverflow,+ ArrayException(..),+ ExitCode(..),++ ioException,+ ioError,+ IOError,+ IOException(..),+ IOErrorType(..),+ userError,+ assertError,+ unsupportedOperation,+ untangle,+ ) where++import GHC.Base+import GHC.List+import GHC.IO+import GHC.Show+import GHC.Read+import GHC.Exception+import Data.Maybe+import GHC.IO.Handle.Types+import Foreign.C.Types++import Data.Typeable ( Typeable )++-- ------------------------------------------------------------------------+-- Exception datatypes and operations++-- |The thread is blocked on an @MVar@, but there are no other references+-- to the @MVar@ so it can't ever continue.+data BlockedIndefinitelyOnMVar = BlockedIndefinitelyOnMVar+ deriving Typeable++instance Exception BlockedIndefinitelyOnMVar++instance Show BlockedIndefinitelyOnMVar where+ showsPrec _ BlockedIndefinitelyOnMVar = showString "thread blocked indefinitely in an MVar operation"++blockedIndefinitelyOnMVar :: SomeException -- for the RTS+blockedIndefinitelyOnMVar = toException BlockedIndefinitelyOnMVar++-----++-- |The thread is awiting to retry an STM transaction, but there are no+-- other references to any @TVar@s involved, so it can't ever continue.+data BlockedIndefinitelyOnSTM = BlockedIndefinitelyOnSTM+ deriving Typeable++instance Exception BlockedIndefinitelyOnSTM++instance Show BlockedIndefinitelyOnSTM where+ showsPrec _ BlockedIndefinitelyOnSTM = showString "thread blocked indefinitely in an STM transaction"++blockedIndefinitelyOnSTM :: SomeException -- for the RTS+blockedIndefinitelyOnSTM = toException BlockedIndefinitelyOnSTM++-----++-- |There are no runnable threads, so the program is deadlocked.+-- The @Deadlock@ exception is raised in the main thread only.+data Deadlock = Deadlock+ deriving Typeable++instance Exception Deadlock++instance Show Deadlock where+ showsPrec _ Deadlock = showString "<<deadlock>>"++-----++-- |There are no runnable threads, so the program is deadlocked.+-- The @Deadlock@ exception is raised in the main thread only.+data AssertionFailed = AssertionFailed String+ deriving Typeable++instance Exception AssertionFailed++instance Show AssertionFailed where+ showsPrec _ (AssertionFailed err) = showString err++-----++-- |Asynchronous exceptions.+data AsyncException+ = StackOverflow+ -- ^The current thread\'s stack exceeded its limit.+ -- Since an exception has been raised, the thread\'s stack+ -- will certainly be below its limit again, but the+ -- programmer should take remedial action+ -- immediately.+ | HeapOverflow+ -- ^The program\'s heap is reaching its limit, and+ -- the program should take action to reduce the amount of+ -- live data it has. Notes:+ --+ -- * It is undefined which thread receives this exception.+ --+ -- * GHC currently does not throw 'HeapOverflow' exceptions.+ | ThreadKilled+ -- ^This exception is raised by another thread+ -- calling 'Control.Concurrent.killThread', or by the system+ -- if it needs to terminate the thread for some+ -- reason.+ | UserInterrupt+ -- ^This exception is raised by default in the main thread of+ -- the program when the user requests to terminate the program+ -- via the usual mechanism(s) (e.g. Control-C in the console).+ deriving (Eq, Ord, Typeable)++instance Exception AsyncException++-- | Exceptions generated by array operations+data ArrayException+ = IndexOutOfBounds String+ -- ^An attempt was made to index an array outside+ -- its declared bounds.+ | UndefinedElement String+ -- ^An attempt was made to evaluate an element of an+ -- array that had not been initialized.+ deriving (Eq, Ord, Typeable)++instance Exception ArrayException++stackOverflow, heapOverflow :: SomeException -- for the RTS+stackOverflow = toException StackOverflow+heapOverflow = toException HeapOverflow++instance Show AsyncException where+ showsPrec _ StackOverflow = showString "stack overflow"+ showsPrec _ HeapOverflow = showString "heap overflow"+ showsPrec _ ThreadKilled = showString "thread killed"+ showsPrec _ UserInterrupt = showString "user interrupt"++instance Show ArrayException where+ showsPrec _ (IndexOutOfBounds s)+ = showString "array index out of range"+ . (if not (null s) then showString ": " . showString s+ else id)+ showsPrec _ (UndefinedElement s)+ = showString "undefined array element"+ . (if not (null s) then showString ": " . showString s+ else id)++-- -----------------------------------------------------------------------------+-- The ExitCode type++-- We need it here because it is used in ExitException in the+-- Exception datatype (above).++data ExitCode+ = ExitSuccess -- ^ indicates successful termination;+ | ExitFailure Int+ -- ^ indicates program failure with an exit code.+ -- The exact interpretation of the code is+ -- operating-system dependent. In particular, some values+ -- may be prohibited (e.g. 0 on a POSIX-compliant system).+ deriving (Eq, Ord, Read, Show, Typeable)++instance Exception ExitCode++ioException :: IOException -> IO a+ioException err = throwIO err++-- | Raise an 'IOError' in the 'IO' monad.+ioError :: IOError -> IO a +ioError = ioException++-- ---------------------------------------------------------------------------+-- IOError type++-- | The Haskell 98 type for exceptions in the 'IO' monad.+-- Any I\/O operation may raise an 'IOError' instead of returning a result.+-- For a more general type of exception, including also those that arise+-- in pure code, see 'Control.Exception.Exception'.+--+-- In Haskell 98, this is an opaque type.+type IOError = IOException++-- |Exceptions that occur in the @IO@ monad.+-- An @IOException@ records a more specific error type, a descriptive+-- string and maybe the handle that was used when the error was+-- flagged.+data IOException+ = IOError {+ ioe_handle :: Maybe Handle, -- the handle used by the action flagging + -- the error.+ ioe_type :: IOErrorType, -- what it was.+ ioe_location :: String, -- location.+ ioe_description :: String, -- error type specific information.+ ioe_errno :: Maybe CInt, -- errno leading to this error, if any.+ ioe_filename :: Maybe FilePath -- filename the error is related to.+ }+ deriving Typeable++instance Exception IOException++instance Eq IOException where+ (IOError h1 e1 loc1 str1 en1 fn1) == (IOError h2 e2 loc2 str2 en2 fn2) = + e1==e2 && str1==str2 && h1==h2 && loc1==loc2 && en1==en2 && fn1==fn2++-- | An abstract type that contains a value for each variant of 'IOError'.+data IOErrorType+ -- Haskell 98:+ = AlreadyExists+ | NoSuchThing+ | ResourceBusy+ | ResourceExhausted+ | EOF+ | IllegalOperation+ | PermissionDenied+ | UserError+ -- GHC only:+ | UnsatisfiedConstraints+ | SystemError+ | ProtocolError+ | OtherError+ | InvalidArgument+ | InappropriateType+ | HardwareFault+ | UnsupportedOperation+ | TimeExpired+ | ResourceVanished+ | Interrupted++instance Eq IOErrorType where+ x == y = getTag x ==# getTag y+ +instance Show IOErrorType where+ showsPrec _ e =+ showString $+ case e of+ AlreadyExists -> "already exists"+ NoSuchThing -> "does not exist"+ ResourceBusy -> "resource busy"+ ResourceExhausted -> "resource exhausted"+ EOF -> "end of file"+ IllegalOperation -> "illegal operation"+ PermissionDenied -> "permission denied"+ UserError -> "user error"+ HardwareFault -> "hardware fault"+ InappropriateType -> "inappropriate type"+ Interrupted -> "interrupted"+ InvalidArgument -> "invalid argument"+ OtherError -> "failed"+ ProtocolError -> "protocol error"+ ResourceVanished -> "resource vanished"+ SystemError -> "system error"+ TimeExpired -> "timeout"+ UnsatisfiedConstraints -> "unsatisified constraints" -- ultra-precise!+ UnsupportedOperation -> "unsupported operation"++-- | Construct an 'IOError' value with a string describing the error.+-- The 'fail' method of the 'IO' instance of the 'Monad' class raises a+-- 'userError', thus:+--+-- > instance Monad IO where +-- > ...+-- > fail s = ioError (userError s)+--+userError :: String -> IOError+userError str = IOError Nothing UserError "" str Nothing Nothing++-- ---------------------------------------------------------------------------+-- Showing IOErrors++instance Show IOException where+ showsPrec p (IOError hdl iot loc s _ fn) =+ (case fn of+ Nothing -> case hdl of+ Nothing -> id+ Just h -> showsPrec p h . showString ": "+ Just name -> showString name . showString ": ") .+ (case loc of+ "" -> id+ _ -> showString loc . showString ": ") .+ showsPrec p iot . + (case s of+ "" -> id+ _ -> showString " (" . showString s . showString ")")++assertError :: Addr# -> Bool -> a -> a+assertError str predicate v+ | predicate = v+ | otherwise = throw (AssertionFailed (untangle str "Assertion failed"))++unsupportedOperation :: IOError+unsupportedOperation = + (IOError Nothing UnsupportedOperation ""+ "Operation is not supported" Nothing Nothing)++{-+(untangle coded message) expects "coded" to be of the form+ "location|details"+It prints+ location message details+-}+untangle :: Addr# -> String -> String+untangle coded message+ = location+ ++ ": "+ ++ message+ ++ details+ ++ "\n"+ where+ coded_str = unpackCStringUtf8# coded++ (location, details)+ = case (span not_bar coded_str) of { (loc, rest) ->+ case rest of+ ('|':det) -> (loc, ' ' : det)+ _ -> (loc, "")+ }+ not_bar c = c /= '|'
+ GHC/IO/Exception.hs-boot view
@@ -0,0 +1,12 @@+{-# OPTIONS -fno-implicit-prelude #-}+module GHC.IO.Exception where++import GHC.Base+import GHC.Exception++data IOException+instance Exception IOException++type IOError = IOException+userError :: String -> IOError+unsupportedOperation :: IOError
+ GHC/IO/FD.hs view
@@ -0,0 +1,633 @@+{-# OPTIONS_GHC -XNoImplicitPrelude -XBangPatterns #-}+{-# OPTIONS_HADDOCK hide #-}+-----------------------------------------------------------------------------+-- |+-- Module : GHC.IO.FD+-- Copyright : (c) The University of Glasgow, 1994-2008+-- License : see libraries/base/LICENSE+-- +-- Maintainer : libraries@haskell.org+-- Stability : internal+-- Portability : non-portable+--+-- Raw read/write operations on file descriptors+--+-----------------------------------------------------------------------------++module GHC.IO.FD (+ FD(..),+ openFile, mkFD, release,+ setNonBlockingMode,+ readRawBufferPtr, readRawBufferPtrNoBlock, writeRawBufferPtr,+ stdin, stdout, stderr+ ) where++#undef DEBUG_DUMP++import GHC.Base+import GHC.Num+import GHC.Real+import GHC.Show+import GHC.Enum+import Data.Maybe+#ifndef mingw32_HOST_OS+import Control.Monad+#endif+import Data.Typeable++import GHC.IO+import GHC.IO.IOMode+import GHC.IO.Buffer+import GHC.IO.BufferedIO+import qualified GHC.IO.Device+import GHC.IO.Device (SeekMode(..), IODeviceType(..))+import GHC.Conc+import GHC.IO.Exception++import Foreign+import Foreign.C+import qualified System.Posix.Internals+import System.Posix.Internals hiding (FD, setEcho, getEcho)+import System.Posix.Types+-- import GHC.Ptr++-- -----------------------------------------------------------------------------+-- The file-descriptor IO device++data FD = FD {+ fdFD :: {-# UNPACK #-} !CInt,+#ifdef mingw32_HOST_OS+ -- On Windows, a socket file descriptor needs to be read and written+ -- using different functions (send/recv).+ fdIsSocket_ :: {-# UNPACK #-} !Int+#else+ -- On Unix we need to know whether this FD has O_NONBLOCK set.+ -- If it has, then we can use more efficient routines to read/write to it.+ -- It is always safe for this to be off.+ fdIsNonBlocking :: {-# UNPACK #-} !Int+#endif+ }+ deriving Typeable++#ifdef mingw32_HOST_OS+fdIsSocket :: FD -> Bool+fdIsSocket fd = fdIsSocket_ fd /= 0+#endif++instance Show FD where+ show fd = show (fdFD fd)++instance GHC.IO.Device.RawIO FD where+ read = fdRead+ readNonBlocking = fdReadNonBlocking+ write = fdWrite+ writeNonBlocking = fdWriteNonBlocking++instance GHC.IO.Device.IODevice FD where+ ready = ready+ close = close+ isTerminal = isTerminal+ isSeekable = isSeekable+ seek = seek+ tell = tell+ getSize = getSize+ setSize = setSize+ setEcho = setEcho+ getEcho = getEcho+ setRaw = setRaw+ devType = devType+ dup = dup+ dup2 = dup2++instance BufferedIO FD where+ newBuffer _dev state = newByteBuffer dEFAULT_BUFFER_SIZE state+ fillReadBuffer fd buf = readBuf' fd buf+ fillReadBuffer0 fd buf = readBufNonBlocking fd buf+ flushWriteBuffer fd buf = writeBuf' fd buf+ flushWriteBuffer0 fd buf = writeBufNonBlocking fd buf++readBuf' :: FD -> Buffer Word8 -> IO (Int, Buffer Word8)+readBuf' fd buf = do+#ifdef DEBUG_DUMP+ puts ("readBuf fd=" ++ show fd ++ " " ++ summaryBuffer buf ++ "\n")+#endif+ (r,buf') <- readBuf fd buf+#ifdef DEBUG_DUMP+ puts ("after: " ++ summaryBuffer buf' ++ "\n")+#endif+ return (r,buf')++writeBuf' :: FD -> Buffer Word8 -> IO (Buffer Word8)+writeBuf' fd buf = do+#ifdef DEBUG_DUMP+ puts ("writeBuf fd=" ++ show fd ++ " " ++ summaryBuffer buf ++ "\n")+#endif+ writeBuf fd buf++-- -----------------------------------------------------------------------------+-- opening files++-- | Open a file and make an 'FD' for it. Truncates the file to zero+-- size when the `IOMode` is `WriteMode`. Puts the file descriptor+-- into non-blocking mode on Unix systems.+openFile :: FilePath -> IOMode -> IO (FD,IODeviceType)+openFile filepath iomode =+ withFilePath filepath $ \ f ->++ let + oflags1 = case iomode of+ ReadMode -> read_flags+#ifdef mingw32_HOST_OS+ WriteMode -> write_flags .|. o_TRUNC+#else+ WriteMode -> write_flags+#endif+ ReadWriteMode -> rw_flags+ AppendMode -> append_flags++#ifdef mingw32_HOST_OS+ binary_flags = o_BINARY+#else+ binary_flags = 0+#endif ++ oflags = oflags1 .|. binary_flags+ in do++ -- the old implementation had a complicated series of three opens,+ -- which is perhaps because we have to be careful not to open+ -- directories. However, the man pages I've read say that open()+ -- always returns EISDIR if the file is a directory and was opened+ -- for writing, so I think we're ok with a single open() here...+ fd <- throwErrnoIfMinus1Retry "openFile"+ (c_open f (fromIntegral oflags) 0o666)++ (fD,fd_type) <- mkFD fd iomode Nothing{-no stat-}+ False{-not a socket-} + True{-is non-blocking-}+ `catchAny` \e -> do _ <- c_close fd+ throwIO e++#ifndef mingw32_HOST_OS+ -- we want to truncate() if this is an open in WriteMode, but only+ -- if the target is a RegularFile. ftruncate() fails on special files+ -- like /dev/null.+ if iomode == WriteMode && fd_type == RegularFile+ then setSize fD 0+ else return ()+#endif++ return (fD,fd_type)++std_flags, output_flags, read_flags, write_flags, rw_flags,+ append_flags :: CInt+std_flags = o_NONBLOCK .|. o_NOCTTY+output_flags = std_flags .|. o_CREAT+read_flags = std_flags .|. o_RDONLY +write_flags = output_flags .|. o_WRONLY+rw_flags = output_flags .|. o_RDWR+append_flags = write_flags .|. o_APPEND+++-- | Make a 'FD' from an existing file descriptor. Fails if the FD+-- refers to a directory. If the FD refers to a file, `mkFD` locks+-- the file according to the Haskell 98 single writer/multiple reader+-- locking semantics (this is why we need the `IOMode` argument too).+mkFD :: CInt+ -> IOMode+ -> Maybe (IODeviceType, CDev, CIno)+ -- the results of fdStat if we already know them, or we want+ -- to prevent fdToHandle_stat from doing its own stat.+ -- These are used for:+ -- - we fail if the FD refers to a directory+ -- - if the FD refers to a file, we lock it using (cdev,cino)+ -> Bool -- ^ is a socket (on Windows)+ -> Bool -- ^ is in non-blocking mode on Unix+ -> IO (FD,IODeviceType)++mkFD fd iomode mb_stat is_socket is_nonblock = do++ let _ = (is_socket, is_nonblock) -- warning suppression++ (fd_type,dev,ino) <- + case mb_stat of+ Nothing -> fdStat fd+ Just stat -> return stat++ let write = case iomode of+ ReadMode -> False+ _ -> True++#ifdef mingw32_HOST_OS+ _ <- setmode fd True -- unconditionally set binary mode+ let _ = (dev,ino,write) -- warning suppression+#endif++ case fd_type of+ Directory -> + ioException (IOError Nothing InappropriateType "openFile"+ "is a directory" Nothing Nothing)++#ifndef mingw32_HOST_OS+ -- regular files need to be locked+ RegularFile -> do+ -- On Windows we use explicit exclusion via sopen() to implement+ -- this locking (see __hscore_open()); on Unix we have to+ -- implment it in the RTS.+ r <- lockFile fd dev ino (fromBool write)+ when (r == -1) $+ ioException (IOError Nothing ResourceBusy "openFile"+ "file is locked" Nothing Nothing)+#endif++ _other_type -> return ()++ return (FD{ fdFD = fd,+#ifndef mingw32_HOST_OS+ fdIsNonBlocking = fromEnum is_nonblock+#else+ fdIsSocket_ = fromEnum is_socket+#endif+ },+ fd_type)++#ifdef mingw32_HOST_OS+foreign import ccall unsafe "__hscore_setmode"+ setmode :: CInt -> Bool -> IO CInt+#endif++-- -----------------------------------------------------------------------------+-- Standard file descriptors++stdFD :: CInt -> FD+stdFD fd = FD { fdFD = fd,+#ifdef mingw32_HOST_OS+ fdIsSocket_ = 0+#else+ fdIsNonBlocking = 0+ -- We don't set non-blocking mode on standard handles, because it may+ -- confuse other applications attached to the same TTY/pipe+ -- see Note [nonblock]+#endif+ }++stdin, stdout, stderr :: FD+stdin = stdFD 0+stdout = stdFD 1+stderr = stdFD 2++-- -----------------------------------------------------------------------------+-- Operations on file descriptors++close :: FD -> IO ()+close fd =+#ifndef mingw32_HOST_OS+ (flip finally) (release fd) $ do+#endif+ throwErrnoIfMinus1Retry_ "GHC.IO.FD.close" $+#ifdef mingw32_HOST_OS+ if fdIsSocket fd then+ c_closesocket (fdFD fd)+ else+#endif+ c_close (fdFD fd)++release :: FD -> IO ()+#ifdef mingw32_HOST_OS+release _ = return ()+#else+release fd = do _ <- unlockFile (fdFD fd)+ return ()+#endif++#ifdef mingw32_HOST_OS+foreign import stdcall unsafe "HsBase.h closesocket"+ c_closesocket :: CInt -> IO CInt+#endif++isSeekable :: FD -> IO Bool+isSeekable fd = do+ t <- devType fd+ return (t == RegularFile || t == RawDevice)++seek :: FD -> SeekMode -> Integer -> IO ()+seek fd mode off = do+ throwErrnoIfMinus1Retry_ "seek" $+ c_lseek (fdFD fd) (fromIntegral off) seektype+ where+ seektype :: CInt+ seektype = case mode of+ AbsoluteSeek -> sEEK_SET+ RelativeSeek -> sEEK_CUR+ SeekFromEnd -> sEEK_END++tell :: FD -> IO Integer+tell fd =+ fromIntegral `fmap`+ (throwErrnoIfMinus1Retry "hGetPosn" $+ c_lseek (fdFD fd) 0 sEEK_CUR)++getSize :: FD -> IO Integer+getSize fd = fdFileSize (fdFD fd)++setSize :: FD -> Integer -> IO () +setSize fd size = do+ throwErrnoIf_ (/=0) "GHC.IO.FD.setSize" $+ c_ftruncate (fdFD fd) (fromIntegral size)++devType :: FD -> IO IODeviceType+devType fd = do (ty,_,_) <- fdStat (fdFD fd); return ty++dup :: FD -> IO FD+dup fd = do+ newfd <- throwErrnoIfMinus1 "GHC.IO.FD.dup" $ c_dup (fdFD fd)+ return fd{ fdFD = newfd }++dup2 :: FD -> FD -> IO FD+dup2 fd fdto = do+ -- Windows' dup2 does not return the new descriptor, unlike Unix+ throwErrnoIfMinus1_ "GHC.IO.FD.dup2" $+ c_dup2 (fdFD fd) (fdFD fdto)+ return fd{ fdFD = fdFD fdto } -- original FD, with the new fdFD++setNonBlockingMode :: FD -> Bool -> IO FD+setNonBlockingMode fd set = do + setNonBlockingFD (fdFD fd) set+#if defined(mingw32_HOST_OS)+ return fd+#else+ return fd{ fdIsNonBlocking = fromEnum set }+#endif++ready :: FD -> Bool -> Int -> IO Bool+ready fd write msecs = do+ r <- throwErrnoIfMinus1Retry "GHC.IO.FD.ready" $+ fdReady (fdFD fd) (fromIntegral $ fromEnum $ write)+ (fromIntegral msecs)+#if defined(mingw32_HOST_OS)+ (fromIntegral $ fromEnum $ fdIsSocket fd)+#else+ 0+#endif+ return (toEnum (fromIntegral r))++foreign import ccall safe "fdReady"+ fdReady :: CInt -> CInt -> CInt -> CInt -> IO CInt++-- ---------------------------------------------------------------------------+-- Terminal-related stuff++isTerminal :: FD -> IO Bool+isTerminal fd = c_isatty (fdFD fd) >>= return.toBool++setEcho :: FD -> Bool -> IO () +setEcho fd on = System.Posix.Internals.setEcho (fdFD fd) on++getEcho :: FD -> IO Bool+getEcho fd = System.Posix.Internals.getEcho (fdFD fd)++setRaw :: FD -> Bool -> IO ()+setRaw fd raw = System.Posix.Internals.setCooked (fdFD fd) (not raw)++-- -----------------------------------------------------------------------------+-- Reading and Writing++fdRead :: FD -> Ptr Word8 -> Int -> IO Int+fdRead fd ptr bytes = do+ r <- readRawBufferPtr "GHC.IO.FD.fdRead" fd ptr 0 (fromIntegral bytes)+ return (fromIntegral r)++fdReadNonBlocking :: FD -> Ptr Word8 -> Int -> IO (Maybe Int)+fdReadNonBlocking fd ptr bytes = do+ r <- readRawBufferPtrNoBlock "GHC.IO.FD.fdReadNonBlocking" fd ptr + 0 (fromIntegral bytes)+ case r of+ (-1) -> return (Nothing)+ n -> return (Just (fromIntegral n))+++fdWrite :: FD -> Ptr Word8 -> Int -> IO ()+fdWrite fd ptr bytes = do+ res <- writeRawBufferPtr "GHC.IO.FD.fdWrite" fd ptr 0 (fromIntegral bytes)+ let res' = fromIntegral res+ if res' < bytes + then fdWrite fd (ptr `plusPtr` res') (bytes - res')+ else return ()++-- XXX ToDo: this isn't non-blocking+fdWriteNonBlocking :: FD -> Ptr Word8 -> Int -> IO Int+fdWriteNonBlocking fd ptr bytes = do+ res <- writeRawBufferPtrNoBlock "GHC.IO.FD.fdWriteNonBlocking" fd ptr 0+ (fromIntegral bytes)+ return (fromIntegral res)++-- -----------------------------------------------------------------------------+-- FD operations++-- Low level routines for reading/writing to (raw)buffers:++#ifndef mingw32_HOST_OS++{-+NOTE [nonblock]:++Unix has broken semantics when it comes to non-blocking I/O: you can+set the O_NONBLOCK flag on an FD, but it applies to the all other FDs+attached to the same underlying file, pipe or TTY; there's no way to+have private non-blocking behaviour for an FD. See bug #724.++We fix this by only setting O_NONBLOCK on FDs that we create; FDs that+come from external sources or are exposed externally are left in+blocking mode. This solution has some problems though. We can't+completely simulate a non-blocking read without O_NONBLOCK: several+cases are wrong here. The cases that are wrong:++ * reading/writing to a blocking FD in non-threaded mode.+ In threaded mode, we just make a safe call to read(). + In non-threaded mode we call select() before attempting to read,+ but that leaves a small race window where the data can be read+ from the file descriptor before we issue our blocking read().+ * readRawBufferNoBlock for a blocking FD++NOTE [2363]:++In the threaded RTS we could just make safe calls to read()/write()+for file descriptors in blocking mode without worrying about blocking+other threads, but the problem with this is that the thread will be+uninterruptible while it is blocked in the foreign call. See #2363.+So now we always call fdReady() before reading, and if fdReady+indicates that there's no data, we call threadWaitRead.++-}++readRawBufferPtr :: String -> FD -> Ptr Word8 -> Int -> CSize -> IO Int+readRawBufferPtr loc !fd buf off len+ | isNonBlocking fd = unsafe_read -- unsafe is ok, it can't block+ | otherwise = do r <- throwErrnoIfMinus1 loc + (unsafe_fdReady (fdFD fd) 0 0 0)+ if r /= 0 + then read+ else do threadWaitRead (fromIntegral (fdFD fd)); read+ where+ do_read call = fromIntegral `fmap`+ throwErrnoIfMinus1RetryMayBlock loc call+ (threadWaitRead (fromIntegral (fdFD fd)))+ read = if threaded then safe_read else unsafe_read+ unsafe_read = do_read (c_read (fdFD fd) (buf `plusPtr` off) len)+ safe_read = do_read (c_safe_read (fdFD fd) (buf `plusPtr` off) len)++-- return: -1 indicates EOF, >=0 is bytes read+readRawBufferPtrNoBlock :: String -> FD -> Ptr Word8 -> Int -> CSize -> IO Int+readRawBufferPtrNoBlock loc !fd buf off len+ | isNonBlocking fd = unsafe_read -- unsafe is ok, it can't block+ | otherwise = do r <- unsafe_fdReady (fdFD fd) 0 0 0+ if r /= 0 then safe_read+ else return 0+ -- XXX see note [nonblock]+ where+ do_read call = do r <- throwErrnoIfMinus1RetryOnBlock loc call (return (-1))+ case r of+ (-1) -> return 0+ 0 -> return (-1)+ n -> return (fromIntegral n)+ unsafe_read = do_read (c_read (fdFD fd) (buf `plusPtr` off) len)+ safe_read = do_read (c_safe_read (fdFD fd) (buf `plusPtr` off) len)++writeRawBufferPtr :: String -> FD -> Ptr Word8 -> Int -> CSize -> IO CInt+writeRawBufferPtr loc !fd buf off len+ | isNonBlocking fd = unsafe_write -- unsafe is ok, it can't block+ | otherwise = do r <- unsafe_fdReady (fdFD fd) 1 0 0+ if r /= 0 + then write+ else do threadWaitWrite (fromIntegral (fdFD fd)); write+ where+ do_write call = fromIntegral `fmap`+ throwErrnoIfMinus1RetryMayBlock loc call+ (threadWaitWrite (fromIntegral (fdFD fd)))+ write = if threaded then safe_write else unsafe_write+ unsafe_write = do_write (c_write (fdFD fd) (buf `plusPtr` off) len)+ safe_write = do_write (c_safe_write (fdFD fd) (buf `plusPtr` off) len)++writeRawBufferPtrNoBlock :: String -> FD -> Ptr Word8 -> Int -> CSize -> IO CInt+writeRawBufferPtrNoBlock loc !fd buf off len+ | isNonBlocking fd = unsafe_write -- unsafe is ok, it can't block+ | otherwise = do r <- unsafe_fdReady (fdFD fd) 1 0 0+ if r /= 0 then write+ else return 0+ where+ do_write call = do r <- throwErrnoIfMinus1RetryOnBlock loc call (return (-1))+ case r of+ (-1) -> return 0+ n -> return (fromIntegral n)+ write = if threaded then safe_write else unsafe_write+ unsafe_write = do_write (c_write (fdFD fd) (buf `plusPtr` off) len)+ safe_write = do_write (c_safe_write (fdFD fd) (buf `plusPtr` off) len)++isNonBlocking :: FD -> Bool+isNonBlocking fd = fdIsNonBlocking fd /= 0++foreign import ccall unsafe "fdReady"+ unsafe_fdReady :: CInt -> CInt -> CInt -> CInt -> IO CInt++#else /* mingw32_HOST_OS.... */++readRawBufferPtr :: String -> FD -> Ptr Word8 -> Int -> CSize -> IO CInt+readRawBufferPtr loc !fd buf off len+ | threaded = blockingReadRawBufferPtr loc fd buf off len+ | otherwise = asyncReadRawBufferPtr loc fd buf off len++writeRawBufferPtr :: String -> FD -> Ptr Word8 -> Int -> CSize -> IO CInt+writeRawBufferPtr loc !fd buf off len+ | threaded = blockingWriteRawBufferPtr loc fd buf off len+ | otherwise = asyncWriteRawBufferPtr loc fd buf off len++readRawBufferPtrNoBlock :: String -> FD -> Ptr Word8 -> Int -> CSize -> IO CInt+readRawBufferPtrNoBlock = readRawBufferPtr++writeRawBufferPtrNoBlock :: String -> FD -> Ptr Word8 -> Int -> CSize -> IO CInt+writeRawBufferPtrNoBlock = writeRawBufferPtr++-- Async versions of the read/write primitives, for the non-threaded RTS++asyncReadRawBufferPtr :: String -> FD -> Ptr Word8 -> Int -> CSize -> IO CInt+asyncReadRawBufferPtr loc !fd buf off len = do+ (l, rc) <- asyncRead (fromIntegral (fdFD fd)) (fdIsSocket_ fd) + (fromIntegral len) (buf `plusPtr` off)+ if l == (-1)+ then + ioError (errnoToIOError loc (Errno (fromIntegral rc)) Nothing Nothing)+ else return (fromIntegral l)++asyncWriteRawBufferPtr :: String -> FD -> Ptr Word8 -> Int -> CSize -> IO CInt+asyncWriteRawBufferPtr loc !fd buf off len = do+ (l, rc) <- asyncWrite (fromIntegral (fdFD fd)) (fdIsSocket_ fd)+ (fromIntegral len) (buf `plusPtr` off)+ if l == (-1)+ then + ioError (errnoToIOError loc (Errno (fromIntegral rc)) Nothing Nothing)+ else return (fromIntegral l)++-- Blocking versions of the read/write primitives, for the threaded RTS++blockingReadRawBufferPtr :: String -> FD -> Ptr Word8 -> Int -> CSize -> IO CInt+blockingReadRawBufferPtr loc fd buf off len+ = fmap fromIntegral $ throwErrnoIfMinus1Retry loc $+ if fdIsSocket fd+ then c_safe_recv (fdFD fd) (buf `plusPtr` off) len 0+ else c_safe_read (fdFD fd) (buf `plusPtr` off) len++blockingWriteRawBufferPtr :: String -> FD -> Ptr Word8-> Int -> CSize -> IO CInt+blockingWriteRawBufferPtr loc fd buf off len + = fmap fromIntegral $ throwErrnoIfMinus1Retry loc $+ if fdIsSocket fd+ then c_safe_send (fdFD fd) (buf `plusPtr` off) len 0+ else c_safe_write (fdFD fd) (buf `plusPtr` off) len++-- NOTE: "safe" versions of the read/write calls for use by the threaded RTS.+-- These calls may block, but that's ok.++foreign import stdcall safe "recv"+ c_safe_recv :: CInt -> Ptr Word8 -> CSize -> CInt{-flags-} -> IO CSsize++foreign import stdcall safe "send"+ c_safe_send :: CInt -> Ptr Word8 -> CSize -> CInt{-flags-} -> IO CSsize++#endif++foreign import ccall "rtsSupportsBoundThreads" threaded :: Bool++-- -----------------------------------------------------------------------------+-- utils++#ifndef mingw32_HOST_OS+throwErrnoIfMinus1RetryOnBlock :: String -> IO CSsize -> IO CSsize -> IO CSsize+throwErrnoIfMinus1RetryOnBlock loc f on_block = + do+ res <- f+ if (res :: CSsize) == -1+ then do+ err <- getErrno+ if err == eINTR+ then throwErrnoIfMinus1RetryOnBlock loc f on_block+ else if err == eWOULDBLOCK || err == eAGAIN+ then do on_block+ else throwErrno loc+ else return res+#endif++-- -----------------------------------------------------------------------------+-- Locking/unlocking++#ifndef mingw32_HOST_OS+foreign import ccall unsafe "lockFile"+ lockFile :: CInt -> CDev -> CIno -> CInt -> IO CInt++foreign import ccall unsafe "unlockFile"+ unlockFile :: CInt -> IO CInt+#endif++#if defined(DEBUG_DUMP)+puts :: String -> IO ()+puts s = do withCStringLen s $ \(p,len) -> c_write 1 p (fromIntegral len)+ return ()+#endif
+ GHC/IO/Handle.hs view
@@ -0,0 +1,734 @@+{-# OPTIONS_GHC -XNoImplicitPrelude -XRecordWildCards #-}+{-# OPTIONS_GHC -fno-warn-unused-matches #-}+-----------------------------------------------------------------------------+-- |+-- Module : GHC.IO.Handle+-- Copyright : (c) The University of Glasgow, 1994-2009+-- License : see libraries/base/LICENSE+-- +-- Maintainer : libraries@haskell.org+-- Stability : provisional+-- Portability : non-portable+--+-- External API for GHC's Handle implementation+--+-----------------------------------------------------------------------------++module GHC.IO.Handle (+ Handle,+ BufferMode(..),+ + mkFileHandle, mkDuplexHandle,+ + hFileSize, hSetFileSize, hIsEOF, hLookAhead,+ hSetBuffering, hSetBinaryMode, hSetEncoding, hGetEncoding,+ hFlush, hFlushAll, hDuplicate, hDuplicateTo,+ + hClose, hClose_help,+ + HandlePosition, HandlePosn(..), hGetPosn, hSetPosn,+ SeekMode(..), hSeek, hTell,+ + hIsOpen, hIsClosed, hIsReadable, hIsWritable, hGetBuffering, hIsSeekable,+ hSetEcho, hGetEcho, hIsTerminalDevice,+ + hSetNewlineMode, Newline(..), NewlineMode(..), nativeNewline,+ noNewlineTranslation, universalNewlineMode, nativeNewlineMode,++ hShow,++ hWaitForInput, hGetChar, hGetLine, hGetContents, hPutChar, hPutStr,++ hGetBuf, hGetBufNonBlocking, hPutBuf, hPutBufNonBlocking+ ) where++import GHC.IO+import GHC.IO.Exception+import GHC.IO.Encoding+import GHC.IO.Buffer+import GHC.IO.BufferedIO ( BufferedIO )+import GHC.IO.Device as IODevice+import GHC.IO.Handle.Types+import GHC.IO.Handle.Internals+import GHC.IO.Handle.Text+import System.IO.Error++import GHC.Base+import GHC.Exception+import GHC.MVar+import GHC.IORef+import GHC.Show+import GHC.Num+import GHC.Real+import Data.Maybe+import Data.Typeable+import Control.Monad++-- ---------------------------------------------------------------------------+-- Closing a handle++-- | Computation 'hClose' @hdl@ makes handle @hdl@ closed. Before the+-- computation finishes, if @hdl@ is writable its buffer is flushed as+-- for 'hFlush'.+-- Performing 'hClose' on a handle that has already been closed has no effect; +-- doing so is not an error. All other operations on a closed handle will fail.+-- If 'hClose' fails for any reason, any further operations (apart from+-- 'hClose') on the handle will still fail as if @hdl@ had been successfully+-- closed.++hClose :: Handle -> IO ()+hClose h@(FileHandle _ m) = do + mb_exc <- hClose' h m+ hClose_maybethrow mb_exc h+hClose h@(DuplexHandle _ r w) = do+ mb_exc1 <- hClose' h w+ mb_exc2 <- hClose' h r+ case mb_exc1 of+ Nothing -> return ()+ Just e -> hClose_maybethrow mb_exc2 h++hClose_maybethrow :: Maybe SomeException -> Handle -> IO ()+hClose_maybethrow Nothing h = return ()+hClose_maybethrow (Just e) h = hClose_rethrow e h++hClose_rethrow :: SomeException -> Handle -> IO ()+hClose_rethrow e h = + case fromException e of+ Just ioe -> ioError (augmentIOError ioe "hClose" h)+ Nothing -> throwIO e++hClose' :: Handle -> MVar Handle__ -> IO (Maybe SomeException)+hClose' h m = withHandle' "hClose" h m $ hClose_help++-----------------------------------------------------------------------------+-- Detecting and changing the size of a file++-- | For a handle @hdl@ which attached to a physical file,+-- 'hFileSize' @hdl@ returns the size of that file in 8-bit bytes.++hFileSize :: Handle -> IO Integer+hFileSize handle =+ withHandle_ "hFileSize" handle $ \ handle_@Handle__{haDevice=dev} -> do+ case haType handle_ of + ClosedHandle -> ioe_closedHandle+ SemiClosedHandle -> ioe_closedHandle+ _ -> do flushWriteBuffer handle_+ r <- IODevice.getSize dev+ if r /= -1+ then return r+ else ioException (IOError Nothing InappropriateType "hFileSize"+ "not a regular file" Nothing Nothing)+++-- | 'hSetFileSize' @hdl@ @size@ truncates the physical file with handle @hdl@ to @size@ bytes.++hSetFileSize :: Handle -> Integer -> IO ()+hSetFileSize handle size =+ withHandle_ "hSetFileSize" handle $ \ handle_@Handle__{haDevice=dev} -> do+ case haType handle_ of + ClosedHandle -> ioe_closedHandle+ SemiClosedHandle -> ioe_closedHandle+ _ -> do flushWriteBuffer handle_+ IODevice.setSize dev size+ return ()++-- ---------------------------------------------------------------------------+-- Detecting the End of Input++-- | For a readable handle @hdl@, 'hIsEOF' @hdl@ returns+-- 'True' if no further input can be taken from @hdl@ or for a+-- physical file, if the current I\/O position is equal to the length of+-- the file. Otherwise, it returns 'False'.+--+-- NOTE: 'hIsEOF' may block, because it is the same as calling+-- 'hLookAhead' and checking for an EOF exception.++hIsEOF :: Handle -> IO Bool+hIsEOF handle =+ catch+ (hLookAhead handle >> return False)+ (\e -> if isEOFError e then return True else ioError e)++-- ---------------------------------------------------------------------------+-- Looking ahead++-- | Computation 'hLookAhead' returns the next character from the handle+-- without removing it from the input buffer, blocking until a character+-- is available.+--+-- This operation may fail with:+--+-- * 'isEOFError' if the end of file has been reached.++hLookAhead :: Handle -> IO Char+hLookAhead handle =+ wantReadableHandle_ "hLookAhead" handle hLookAhead_++-- ---------------------------------------------------------------------------+-- Buffering Operations++-- Three kinds of buffering are supported: line-buffering,+-- block-buffering or no-buffering. See GHC.IO.Handle for definition and+-- further explanation of what the type represent.++-- | Computation 'hSetBuffering' @hdl mode@ sets the mode of buffering for+-- handle @hdl@ on subsequent reads and writes.+--+-- If the buffer mode is changed from 'BlockBuffering' or+-- 'LineBuffering' to 'NoBuffering', then+--+-- * if @hdl@ is writable, the buffer is flushed as for 'hFlush';+--+-- * if @hdl@ is not writable, the contents of the buffer is discarded.+--+-- This operation may fail with:+--+-- * 'isPermissionError' if the handle has already been used for reading+-- or writing and the implementation does not allow the buffering mode+-- to be changed.++hSetBuffering :: Handle -> BufferMode -> IO ()+hSetBuffering handle mode =+ withAllHandles__ "hSetBuffering" handle $ \ handle_@Handle__{..} -> do+ case haType of+ ClosedHandle -> ioe_closedHandle+ _ -> do+ if mode == haBufferMode then return handle_ else do++ {- Note:+ - we flush the old buffer regardless of whether+ the new buffer could fit the contents of the old buffer + or not.+ - allow a handle's buffering to change even if IO has+ occurred (ANSI C spec. does not allow this, nor did+ the previous implementation of IO.hSetBuffering).+ - a non-standard extension is to allow the buffering+ of semi-closed handles to change [sof 6/98]+ -}+ flushCharBuffer handle_++ let state = initBufferState haType+ reading = not (isWritableHandleType haType)++ new_buf <-+ case mode of+ -- See [note Buffer Sizing], GHC.IO.Handle.Types+ NoBuffering | reading -> newCharBuffer dEFAULT_CHAR_BUFFER_SIZE state+ | otherwise -> newCharBuffer 1 state+ LineBuffering -> newCharBuffer dEFAULT_CHAR_BUFFER_SIZE state+ BlockBuffering Nothing -> newCharBuffer dEFAULT_CHAR_BUFFER_SIZE state+ BlockBuffering (Just n) | n <= 0 -> ioe_bufsiz n+ | otherwise -> newCharBuffer n state++ writeIORef haCharBuffer new_buf++ -- for input terminals we need to put the terminal into+ -- cooked or raw mode depending on the type of buffering.+ is_tty <- IODevice.isTerminal haDevice+ when (is_tty && isReadableHandleType haType) $+ case mode of+#ifndef mingw32_HOST_OS+ -- 'raw' mode under win32 is a bit too specialised (and troublesome+ -- for most common uses), so simply disable its use here.+ NoBuffering -> IODevice.setRaw haDevice True+#else+ NoBuffering -> return ()+#endif+ _ -> IODevice.setRaw haDevice False++ -- throw away spare buffers, they might be the wrong size+ writeIORef haBuffers BufferListNil++ return Handle__{ haBufferMode = mode,.. }++-- -----------------------------------------------------------------------------+-- hSetEncoding++-- | The action 'hSetEncoding' @hdl@ @encoding@ changes the text encoding+-- for the handle @hdl@ to @encoding@. The default encoding when a 'Handle' is+-- created is 'localeEncoding', namely the default encoding for the current+-- locale.+--+-- To create a 'Handle' with no encoding at all, use 'openBinaryFile'. To+-- stop further encoding or decoding on an existing 'Handle', use+-- 'hSetBinaryMode'.+--+-- 'hSetEncoding' may need to flush buffered data in order to change+-- the encoding.+--+hSetEncoding :: Handle -> TextEncoding -> IO ()+hSetEncoding hdl encoding = do+ withHandle "hSetEncoding" hdl $ \h_@Handle__{..} -> do+ flushCharBuffer h_+ openTextEncoding (Just encoding) haType $ \ mb_encoder mb_decoder -> do+ bbuf <- readIORef haByteBuffer+ ref <- newIORef (error "last_decode")+ return (Handle__{ haLastDecode = ref, + haDecoder = mb_decoder, + haEncoder = mb_encoder,+ haCodec = Just encoding, .. },+ ())++-- | Return the current 'TextEncoding' for the specified 'Handle', or+-- 'Nothing' if the 'Handle' is in binary mode.+--+-- Note that the 'TextEncoding' remembers nothing about the state of+-- the encoder/decoder in use on this 'Handle'. For example, if the+-- encoding in use is UTF-16, then using 'hGetEncoding' and+-- 'hSetEncoding' to save and restore the encoding may result in an+-- extra byte-order-mark being written to the file.+--+hGetEncoding :: Handle -> IO (Maybe TextEncoding)+hGetEncoding hdl =+ withHandle_ "hGetEncoding" hdl $ \h_@Handle__{..} -> return haCodec++-- -----------------------------------------------------------------------------+-- hFlush++-- | The action 'hFlush' @hdl@ causes any items buffered for output+-- in handle @hdl@ to be sent immediately to the operating system.+--+-- This operation may fail with:+--+-- * 'isFullError' if the device is full;+--+-- * 'isPermissionError' if a system resource limit would be exceeded.+-- It is unspecified whether the characters in the buffer are discarded+-- or retained under these circumstances.++hFlush :: Handle -> IO () +hFlush handle = wantWritableHandle "hFlush" handle flushWriteBuffer++-- | The action 'hFlushAll' @hdl@ flushes all buffered data in @hdl@,+-- including any buffered read data. Buffered read data is flushed+-- by seeking the file position back to the point before the bufferred+-- data was read, and hence only works if @hdl@ is seekable (see+-- 'hIsSeekable').+--+-- This operation may fail with:+--+-- * 'isFullError' if the device is full;+--+-- * 'isPermissionError' if a system resource limit would be exceeded.+-- It is unspecified whether the characters in the buffer are discarded+-- or retained under these circumstances;+--+-- * 'isIllegalOperation' if @hdl@ has buffered read data, and is not+-- seekable.++hFlushAll :: Handle -> IO () +hFlushAll handle = withHandle_ "hFlushAll" handle flushBuffer++-- -----------------------------------------------------------------------------+-- Repositioning Handles++data HandlePosn = HandlePosn Handle HandlePosition++instance Eq HandlePosn where+ (HandlePosn h1 p1) == (HandlePosn h2 p2) = p1==p2 && h1==h2++instance Show HandlePosn where+ showsPrec p (HandlePosn h pos) = + showsPrec p h . showString " at position " . shows pos++ -- HandlePosition is the Haskell equivalent of POSIX' off_t.+ -- We represent it as an Integer on the Haskell side, but+ -- cheat slightly in that hGetPosn calls upon a C helper+ -- that reports the position back via (merely) an Int.+type HandlePosition = Integer++-- | Computation 'hGetPosn' @hdl@ returns the current I\/O position of+-- @hdl@ as a value of the abstract type 'HandlePosn'.++hGetPosn :: Handle -> IO HandlePosn+hGetPosn handle = do+ posn <- hTell handle+ return (HandlePosn handle posn)++-- | If a call to 'hGetPosn' @hdl@ returns a position @p@,+-- then computation 'hSetPosn' @p@ sets the position of @hdl@+-- to the position it held at the time of the call to 'hGetPosn'.+--+-- This operation may fail with:+--+-- * 'isPermissionError' if a system resource limit would be exceeded.++hSetPosn :: HandlePosn -> IO () +hSetPosn (HandlePosn h i) = hSeek h AbsoluteSeek i++-- ---------------------------------------------------------------------------+-- hSeek++{- Note: + - when seeking using `SeekFromEnd', positive offsets (>=0) means+ seeking at or past EOF.++ - we possibly deviate from the report on the issue of seeking within+ the buffer and whether to flush it or not. The report isn't exactly+ clear here.+-}++-- | Computation 'hSeek' @hdl mode i@ sets the position of handle+-- @hdl@ depending on @mode@.+-- The offset @i@ is given in terms of 8-bit bytes.+--+-- If @hdl@ is block- or line-buffered, then seeking to a position which is not+-- in the current buffer will first cause any items in the output buffer to be+-- written to the device, and then cause the input buffer to be discarded.+-- Some handles may not be seekable (see 'hIsSeekable'), or only support a+-- subset of the possible positioning operations (for instance, it may only+-- be possible to seek to the end of a tape, or to a positive offset from+-- the beginning or current position).+-- It is not possible to set a negative I\/O position, or for+-- a physical file, an I\/O position beyond the current end-of-file.+--+-- This operation may fail with:+--+-- * 'isPermissionError' if a system resource limit would be exceeded.++hSeek :: Handle -> SeekMode -> Integer -> IO () +hSeek handle mode offset =+ wantSeekableHandle "hSeek" handle $ \ handle_@Handle__{..} -> do+ debugIO ("hSeek " ++ show (mode,offset))+ buf <- readIORef haCharBuffer++ if isWriteBuffer buf+ then do flushWriteBuffer handle_+ IODevice.seek haDevice mode offset+ else do++ let r = bufL buf; w = bufR buf+ if mode == RelativeSeek && isNothing haDecoder && + offset >= 0 && offset < fromIntegral (w - r)+ then writeIORef haCharBuffer buf{ bufL = r + fromIntegral offset }+ else do ++ flushCharReadBuffer handle_+ flushByteReadBuffer handle_+ IODevice.seek haDevice mode offset+++hTell :: Handle -> IO Integer+hTell handle = + wantSeekableHandle "hGetPosn" handle $ \ handle_@Handle__{..} -> do++ posn <- IODevice.tell haDevice++ cbuf <- readIORef haCharBuffer+ bbuf <- readIORef haByteBuffer++ let real_posn + | isWriteBuffer cbuf = posn + fromIntegral (bufR cbuf)+ | otherwise = posn - fromIntegral (bufR cbuf - bufL cbuf)+ - fromIntegral (bufR bbuf - bufL bbuf)++ debugIO ("\nhGetPosn: (posn, real_posn) = " ++ show (posn, real_posn))+ debugIO (" cbuf: " ++ summaryBuffer cbuf +++ " bbuf: " ++ summaryBuffer bbuf)++ return real_posn++-- -----------------------------------------------------------------------------+-- Handle Properties++-- A number of operations return information about the properties of a+-- handle. Each of these operations returns `True' if the handle has+-- the specified property, and `False' otherwise.++hIsOpen :: Handle -> IO Bool+hIsOpen handle =+ withHandle_ "hIsOpen" handle $ \ handle_ -> do+ case haType handle_ of + ClosedHandle -> return False+ SemiClosedHandle -> return False+ _ -> return True++hIsClosed :: Handle -> IO Bool+hIsClosed handle =+ withHandle_ "hIsClosed" handle $ \ handle_ -> do+ case haType handle_ of + ClosedHandle -> return True+ _ -> return False++{- not defined, nor exported, but mentioned+ here for documentation purposes:++ hSemiClosed :: Handle -> IO Bool+ hSemiClosed h = do+ ho <- hIsOpen h+ hc <- hIsClosed h+ return (not (ho || hc))+-}++hIsReadable :: Handle -> IO Bool+hIsReadable (DuplexHandle _ _ _) = return True+hIsReadable handle =+ withHandle_ "hIsReadable" handle $ \ handle_ -> do+ case haType handle_ of + ClosedHandle -> ioe_closedHandle+ SemiClosedHandle -> ioe_closedHandle+ htype -> return (isReadableHandleType htype)++hIsWritable :: Handle -> IO Bool+hIsWritable (DuplexHandle _ _ _) = return True+hIsWritable handle =+ withHandle_ "hIsWritable" handle $ \ handle_ -> do+ case haType handle_ of + ClosedHandle -> ioe_closedHandle+ SemiClosedHandle -> ioe_closedHandle+ htype -> return (isWritableHandleType htype)++-- | Computation 'hGetBuffering' @hdl@ returns the current buffering mode+-- for @hdl@.++hGetBuffering :: Handle -> IO BufferMode+hGetBuffering handle = + withHandle_ "hGetBuffering" handle $ \ handle_ -> do+ case haType handle_ of + ClosedHandle -> ioe_closedHandle+ _ -> + -- We're being non-standard here, and allow the buffering+ -- of a semi-closed handle to be queried. -- sof 6/98+ return (haBufferMode handle_) -- could be stricter..++hIsSeekable :: Handle -> IO Bool+hIsSeekable handle =+ withHandle_ "hIsSeekable" handle $ \ handle_@Handle__{..} -> do+ case haType of + ClosedHandle -> ioe_closedHandle+ SemiClosedHandle -> ioe_closedHandle+ AppendHandle -> return False+ _ -> IODevice.isSeekable haDevice++-- -----------------------------------------------------------------------------+-- Changing echo status (Non-standard GHC extensions)++-- | Set the echoing status of a handle connected to a terminal.++hSetEcho :: Handle -> Bool -> IO ()+hSetEcho handle on = do+ isT <- hIsTerminalDevice handle+ if not isT+ then return ()+ else+ withHandle_ "hSetEcho" handle $ \ Handle__{..} -> do+ case haType of + ClosedHandle -> ioe_closedHandle+ _ -> IODevice.setEcho haDevice on++-- | Get the echoing status of a handle connected to a terminal.++hGetEcho :: Handle -> IO Bool+hGetEcho handle = do+ isT <- hIsTerminalDevice handle+ if not isT+ then return False+ else+ withHandle_ "hGetEcho" handle $ \ Handle__{..} -> do+ case haType of + ClosedHandle -> ioe_closedHandle+ _ -> IODevice.getEcho haDevice++-- | Is the handle connected to a terminal?++hIsTerminalDevice :: Handle -> IO Bool+hIsTerminalDevice handle = do+ withHandle_ "hIsTerminalDevice" handle $ \ Handle__{..} -> do+ case haType of + ClosedHandle -> ioe_closedHandle+ _ -> IODevice.isTerminal haDevice++-- -----------------------------------------------------------------------------+-- hSetBinaryMode++-- | Select binary mode ('True') or text mode ('False') on a open handle.+-- (See also 'openBinaryFile'.)+--+-- This has the same effect as calling 'hSetEncoding' with 'latin1', together+-- with 'hSetNewlineMode' with 'noNewlineTranslation'.+--+hSetBinaryMode :: Handle -> Bool -> IO ()+hSetBinaryMode handle bin =+ withAllHandles__ "hSetBinaryMode" handle $ \ h_@Handle__{..} ->+ do + flushCharBuffer h_++ let mb_te | bin = Nothing+ | otherwise = Just localeEncoding++ openTextEncoding mb_te haType $ \ mb_encoder mb_decoder -> do++ -- should match the default newline mode, whatever that is+ let nl | bin = noNewlineTranslation+ | otherwise = nativeNewlineMode++ bbuf <- readIORef haByteBuffer+ ref <- newIORef (error "codec_state", bbuf)++ return Handle__{ haLastDecode = ref,+ haEncoder = mb_encoder, + haDecoder = mb_decoder,+ haCodec = mb_te,+ haInputNL = inputNL nl,+ haOutputNL = outputNL nl, .. }+ +-- -----------------------------------------------------------------------------+-- hSetNewlineMode++-- | Set the 'NewlineMode' on the specified 'Handle'. All buffered+-- data is flushed first.+hSetNewlineMode :: Handle -> NewlineMode -> IO ()+hSetNewlineMode handle NewlineMode{ inputNL=i, outputNL=o } =+ withAllHandles__ "hSetNewlineMode" handle $ \h_@Handle__{..} ->+ do+ flushBuffer h_+ return h_{ haInputNL=i, haOutputNL=o }++-- -----------------------------------------------------------------------------+-- Duplicating a Handle++-- | Returns a duplicate of the original handle, with its own buffer.+-- The two Handles will share a file pointer, however. The original+-- handle's buffer is flushed, including discarding any input data,+-- before the handle is duplicated.++hDuplicate :: Handle -> IO Handle+hDuplicate h@(FileHandle path m) = do+ withHandle_' "hDuplicate" h m $ \h_ ->+ dupHandle path h Nothing h_ (Just handleFinalizer)+hDuplicate h@(DuplexHandle path r w) = do+ write_side@(FileHandle _ write_m) <- + withHandle_' "hDuplicate" h w $ \h_ ->+ dupHandle path h Nothing h_ (Just handleFinalizer)+ read_side@(FileHandle _ read_m) <- + withHandle_' "hDuplicate" h r $ \h_ ->+ dupHandle path h (Just write_m) h_ Nothing+ return (DuplexHandle path read_m write_m)++dupHandle :: FilePath+ -> Handle+ -> Maybe (MVar Handle__)+ -> Handle__+ -> Maybe HandleFinalizer+ -> IO Handle+dupHandle filepath h other_side h_@Handle__{..} mb_finalizer = do+ -- flush the buffer first, so we don't have to copy its contents+ flushBuffer h_+ case other_side of+ Nothing -> do+ new_dev <- IODevice.dup haDevice+ dupHandle_ new_dev filepath other_side h_ mb_finalizer+ Just r -> + withHandle_' "dupHandle" h r $ \Handle__{haDevice=dev} -> do+ dupHandle_ dev filepath other_side h_ mb_finalizer++dupHandle_ :: (IODevice dev, BufferedIO dev, Typeable dev) => dev+ -> FilePath+ -> Maybe (MVar Handle__)+ -> Handle__+ -> Maybe HandleFinalizer+ -> IO Handle+dupHandle_ new_dev filepath other_side h_@Handle__{..} mb_finalizer = do+ -- XXX wrong!+ let mb_codec = if isJust haEncoder then Just localeEncoding else Nothing+ mkHandle new_dev filepath haType True{-buffered-} mb_codec+ NewlineMode { inputNL = haInputNL, outputNL = haOutputNL }+ mb_finalizer other_side++-- -----------------------------------------------------------------------------+-- Replacing a Handle++{- |+Makes the second handle a duplicate of the first handle. The second +handle will be closed first, if it is not already.++This can be used to retarget the standard Handles, for example:++> do h <- openFile "mystdout" WriteMode+> hDuplicateTo h stdout+-}++hDuplicateTo :: Handle -> Handle -> IO ()+hDuplicateTo h1@(FileHandle path m1) h2@(FileHandle _ m2) = do+ withHandle__' "hDuplicateTo" h2 m2 $ \h2_ -> do+ _ <- hClose_help h2_+ withHandle_' "hDuplicateTo" h1 m1 $ \h1_ -> do+ dupHandleTo path h1 Nothing h2_ h1_ (Just handleFinalizer)+hDuplicateTo h1@(DuplexHandle path r1 w1) h2@(DuplexHandle _ r2 w2) = do+ withHandle__' "hDuplicateTo" h2 w2 $ \w2_ -> do+ _ <- hClose_help w2_+ withHandle_' "hDuplicateTo" h1 w1 $ \w1_ -> do+ dupHandleTo path h1 Nothing w2_ w1_ (Just handleFinalizer)+ withHandle__' "hDuplicateTo" h2 r2 $ \r2_ -> do+ _ <- hClose_help r2_+ withHandle_' "hDuplicateTo" h1 r1 $ \r1_ -> do+ dupHandleTo path h1 (Just w1) r2_ r1_ Nothing+hDuplicateTo h1 _ = + ioe_dupHandlesNotCompatible h1+++ioe_dupHandlesNotCompatible :: Handle -> IO a+ioe_dupHandlesNotCompatible h =+ ioException (IOError (Just h) IllegalOperation "hDuplicateTo" + "handles are incompatible" Nothing Nothing)++dupHandleTo :: FilePath + -> Handle+ -> Maybe (MVar Handle__)+ -> Handle__+ -> Handle__+ -> Maybe HandleFinalizer+ -> IO Handle__+dupHandleTo filepath h other_side + hto_@Handle__{haDevice=devTo,..}+ h_@Handle__{haDevice=dev} mb_finalizer = do+ flushBuffer h_+ case cast devTo of+ Nothing -> ioe_dupHandlesNotCompatible h+ Just dev' -> do + _ <- IODevice.dup2 dev dev'+ FileHandle _ m <- dupHandle_ dev' filepath other_side h_ mb_finalizer+ takeMVar m++-- ---------------------------------------------------------------------------+-- showing Handles.+--+-- | 'hShow' is in the 'IO' monad, and gives more comprehensive output+-- than the (pure) instance of 'Show' for 'Handle'.++hShow :: Handle -> IO String+hShow h@(FileHandle path _) = showHandle' path False h+hShow h@(DuplexHandle path _ _) = showHandle' path True h++showHandle' :: String -> Bool -> Handle -> IO String+showHandle' filepath is_duplex h = + withHandle_ "showHandle" h $ \hdl_ ->+ let+ showType | is_duplex = showString "duplex (read-write)"+ | otherwise = shows (haType hdl_)+ in+ return + (( showChar '{' . + showHdl (haType hdl_) + (showString "loc=" . showString filepath . showChar ',' .+ showString "type=" . showType . showChar ',' .+ showString "buffering=" . showBufMode (unsafePerformIO (readIORef (haCharBuffer hdl_))) (haBufferMode hdl_) . showString "}" )+ ) "")+ where++ showHdl :: HandleType -> ShowS -> ShowS+ showHdl ht cont = + case ht of+ ClosedHandle -> shows ht . showString "}"+ _ -> cont++ showBufMode :: Buffer e -> BufferMode -> ShowS+ showBufMode buf bmo =+ case bmo of+ NoBuffering -> showString "none"+ LineBuffering -> showString "line"+ BlockBuffering (Just n) -> showString "block " . showParen True (shows n)+ BlockBuffering Nothing -> showString "block " . showParen True (shows def)+ where+ def :: Int + def = bufSize buf
+ GHC/IO/Handle.hs-boot view
@@ -0,0 +1,8 @@+{-# OPTIONS_GHC -XNoImplicitPrelude #-}++module GHC.IO.Handle where++import GHC.IO+import GHC.IO.Handle.Types++hFlush :: Handle -> IO ()
+ GHC/IO/Handle/FD.hs view
@@ -0,0 +1,271 @@+{-# OPTIONS_GHC -XNoImplicitPrelude #-}+-----------------------------------------------------------------------------+-- |+-- Module : GHC.IO.Handle.FD+-- Copyright : (c) The University of Glasgow, 1994-2008+-- License : see libraries/base/LICENSE+-- +-- Maintainer : libraries@haskell.org+-- Stability : internal+-- Portability : non-portable+--+-- Handle operations implemented by file descriptors (FDs)+--+-----------------------------------------------------------------------------++module GHC.IO.Handle.FD ( + stdin, stdout, stderr,+ openFile, openBinaryFile,+ mkHandleFromFD, fdToHandle, fdToHandle',+ isEOF+ ) where++import GHC.Base+import GHC.Num+import GHC.Real+import GHC.Show+import Data.Maybe+-- import Control.Monad+import Foreign.C.Types+import GHC.MVar+import GHC.IO+import GHC.IO.Encoding+-- import GHC.IO.Exception+import GHC.IO.Device as IODevice+import GHC.IO.Exception+import GHC.IO.IOMode+import GHC.IO.Handle+import GHC.IO.Handle.Types+import GHC.IO.Handle.Internals+import GHC.IO.FD (FD(..))+import qualified GHC.IO.FD as FD+import qualified System.Posix.Internals as Posix++-- ---------------------------------------------------------------------------+-- Standard Handles++-- Three handles are allocated during program initialisation. The first+-- two manage input or output from the Haskell program's standard input+-- or output channel respectively. The third manages output to the+-- standard error channel. These handles are initially open.++-- | A handle managing input from the Haskell program's standard input channel.+stdin :: Handle+stdin = unsafePerformIO $ do+ -- ToDo: acquire lock+ setBinaryMode FD.stdin+ mkHandle FD.stdin "<stdin>" ReadHandle True (Just localeEncoding)+ nativeNewlineMode{-translate newlines-}+ (Just stdHandleFinalizer) Nothing++-- | A handle managing output to the Haskell program's standard output channel.+stdout :: Handle+stdout = unsafePerformIO $ do+ -- ToDo: acquire lock+ setBinaryMode FD.stdout+ mkHandle FD.stdout "<stdout>" WriteHandle True (Just localeEncoding)+ nativeNewlineMode{-translate newlines-}+ (Just stdHandleFinalizer) Nothing++-- | A handle managing output to the Haskell program's standard error channel.+stderr :: Handle+stderr = unsafePerformIO $ do+ -- ToDo: acquire lock+ setBinaryMode FD.stderr+ mkHandle FD.stderr "<stderr>" WriteHandle False{-stderr is unbuffered-} + (Just localeEncoding)+ nativeNewlineMode{-translate newlines-}+ (Just stdHandleFinalizer) Nothing++stdHandleFinalizer :: FilePath -> MVar Handle__ -> IO ()+stdHandleFinalizer fp m = do+ h_ <- takeMVar m+ flushWriteBuffer h_+ putMVar m (ioe_finalizedHandle fp)++-- We have to put the FDs into binary mode on Windows to avoid the newline+-- translation that the CRT IO library does.+setBinaryMode :: FD -> IO ()+#ifdef mingw32_HOST_OS+setBinaryMode fd = do _ <- setmode (fdFD fd) True+ return ()+#else+setBinaryMode _ = return ()+#endif++#ifdef mingw32_HOST_OS+foreign import ccall unsafe "__hscore_setmode"+ setmode :: CInt -> Bool -> IO CInt+#endif++-- ---------------------------------------------------------------------------+-- isEOF++-- | The computation 'isEOF' is identical to 'hIsEOF',+-- except that it works only on 'stdin'.++isEOF :: IO Bool+isEOF = hIsEOF stdin++-- ---------------------------------------------------------------------------+-- Opening and Closing Files++addFilePathToIOError :: String -> FilePath -> IOException -> IOException+addFilePathToIOError fun fp ioe+ = ioe{ ioe_location = fun, ioe_filename = Just fp }++-- | Computation 'openFile' @file mode@ allocates and returns a new, open+-- handle to manage the file @file@. It manages input if @mode@+-- is 'ReadMode', output if @mode@ is 'WriteMode' or 'AppendMode',+-- and both input and output if mode is 'ReadWriteMode'.+--+-- If the file does not exist and it is opened for output, it should be+-- created as a new file. If @mode@ is 'WriteMode' and the file+-- already exists, then it should be truncated to zero length.+-- Some operating systems delete empty files, so there is no guarantee+-- that the file will exist following an 'openFile' with @mode@+-- 'WriteMode' unless it is subsequently written to successfully.+-- The handle is positioned at the end of the file if @mode@ is+-- 'AppendMode', and otherwise at the beginning (in which case its+-- internal position is 0).+-- The initial buffer mode is implementation-dependent.+--+-- This operation may fail with:+--+-- * 'isAlreadyInUseError' if the file is already open and cannot be reopened;+--+-- * 'isDoesNotExistError' if the file does not exist; or+--+-- * 'isPermissionError' if the user does not have permission to open the file.+--+-- Note: if you will be working with files containing binary data, you'll want to+-- be using 'openBinaryFile'.+openFile :: FilePath -> IOMode -> IO Handle+openFile fp im = + catchException+ (openFile' fp im dEFAULT_OPEN_IN_BINARY_MODE)+ (\e -> ioError (addFilePathToIOError "openFile" fp e))++-- | Like 'openFile', but open the file in binary mode.+-- On Windows, reading a file in text mode (which is the default)+-- will translate CRLF to LF, and writing will translate LF to CRLF.+-- This is usually what you want with text files. With binary files+-- this is undesirable; also, as usual under Microsoft operating systems,+-- text mode treats control-Z as EOF. Binary mode turns off all special+-- treatment of end-of-line and end-of-file characters.+-- (See also 'hSetBinaryMode'.)++openBinaryFile :: FilePath -> IOMode -> IO Handle+openBinaryFile fp m =+ catchException+ (openFile' fp m True)+ (\e -> ioError (addFilePathToIOError "openBinaryFile" fp e))++openFile' :: String -> IOMode -> Bool -> IO Handle+openFile' filepath iomode binary = do+ -- first open the file to get an FD+ (fd, fd_type) <- FD.openFile filepath iomode++ let mb_codec = if binary then Nothing else Just localeEncoding++ -- then use it to make a Handle+ mkHandleFromFD fd fd_type filepath iomode True{-non-blocking-} mb_codec+ `onException` IODevice.close fd+ -- NB. don't forget to close the FD if mkHandleFromFD fails, otherwise+ -- this FD leaks.+ -- ASSERT: if we just created the file, then fdToHandle' won't fail+ -- (so we don't need to worry about removing the newly created file+ -- in the event of an error).+++-- ---------------------------------------------------------------------------+-- Converting file descriptors to Handles++mkHandleFromFD+ :: FD+ -> IODeviceType+ -> FilePath -- a string describing this file descriptor (e.g. the filename)+ -> IOMode+ -> Bool -- non_blocking (*sets* non-blocking mode on the FD)+ -> Maybe TextEncoding+ -> IO Handle++mkHandleFromFD fd0 fd_type filepath iomode set_non_blocking mb_codec+ = do+#ifndef mingw32_HOST_OS+ -- turn on non-blocking mode+ fd <- if set_non_blocking + then FD.setNonBlockingMode fd0 True+ else return fd0+#else+ let _ = set_non_blocking -- warning suppression+ fd <- return fd0+#endif++ let nl | isJust mb_codec = nativeNewlineMode+ | otherwise = noNewlineTranslation++ case fd_type of+ Directory -> + ioException (IOError Nothing InappropriateType "openFile"+ "is a directory" Nothing Nothing)++ Stream+ -- only *Streams* can be DuplexHandles. Other read/write+ -- Handles must share a buffer.+ | ReadWriteMode <- iomode -> + mkDuplexHandle fd filepath mb_codec nl+ ++ _other -> + mkFileHandle fd filepath iomode mb_codec nl++-- | Old API kept to avoid breaking clients+fdToHandle' :: CInt+ -> Maybe IODeviceType+ -> Bool -- is_socket on Win, non-blocking on Unix+ -> FilePath+ -> IOMode+ -> Bool -- binary+ -> IO Handle+fdToHandle' fdint mb_type is_socket filepath iomode binary = do+ let mb_stat = case mb_type of+ Nothing -> Nothing+ -- mkFD will do the stat:+ Just RegularFile -> Nothing+ -- no stat required for streams etc.:+ Just other -> Just (other,0,0)+ (fd,fd_type) <- FD.mkFD (fromIntegral fdint) iomode mb_stat+ is_socket+ is_socket+ mkHandleFromFD fd fd_type filepath iomode is_socket+ (if binary then Nothing else Just localeEncoding)+++-- | Turn an existing file descriptor into a Handle. This is used by+-- various external libraries to make Handles.+--+-- Makes a binary Handle. This is for historical reasons; it should+-- probably be a text Handle with the default encoding and newline+-- translation instead.+fdToHandle :: Posix.FD -> IO Handle+fdToHandle fdint = do+ iomode <- Posix.fdGetMode (fromIntegral fdint)+ (fd,fd_type) <- FD.mkFD (fromIntegral fdint) iomode Nothing+ False{-is_socket-} + -- NB. the is_socket flag is False, meaning that:+ -- on Windows we're guessing this is not a socket (XXX)+ False{-is_nonblock-}+ -- file descriptors that we get from external sources are+ -- not put into non-blocking mode, becuase that would affect+ -- other users of the file descriptor+ let fd_str = "<file descriptor: " ++ show fd ++ ">"+ mkHandleFromFD fd fd_type fd_str iomode False{-non-block-} + Nothing -- bin mode++-- ---------------------------------------------------------------------------+-- Are files opened by default in text or binary mode, if the user doesn't+-- specify?++dEFAULT_OPEN_IN_BINARY_MODE :: Bool+dEFAULT_OPEN_IN_BINARY_MODE = False
+ GHC/IO/Handle/FD.hs-boot view
@@ -0,0 +1,7 @@+{-# OPTIONS_GHC -XNoImplicitPrelude #-}+module GHC.IO.Handle.FD where++import GHC.IO.Handle.Types++-- used in GHC.Conc, which is below GHC.IO.Handle.FD+stdout :: Handle
+ GHC/IO/Handle/Internals.hs view
@@ -0,0 +1,806 @@+{-# OPTIONS_GHC -XNoImplicitPrelude -#include "HsBase.h" #-}+{-# OPTIONS_GHC -fno-warn-unused-matches #-}+{-# OPTIONS_GHC -fno-warn-name-shadowing #-}+{-# OPTIONS_GHC -XRecordWildCards #-}+{-# OPTIONS_HADDOCK hide #-}++#undef DEBUG_DUMP++-----------------------------------------------------------------------------+-- |+-- Module : GHC.IO.Handle.Internals+-- Copyright : (c) The University of Glasgow, 1994-2001+-- License : see libraries/base/LICENSE+-- +-- Maintainer : libraries@haskell.org+-- Stability : internal+-- Portability : non-portable+--+-- This module defines the basic operations on I\/O \"handles\". All+-- of the operations defined here are independent of the underlying+-- device.+--+-----------------------------------------------------------------------------++-- #hide+module GHC.IO.Handle.Internals (+ withHandle, withHandle', withHandle_,+ withHandle__', withHandle_', withAllHandles__,+ wantWritableHandle, wantReadableHandle, wantReadableHandle_, + wantSeekableHandle,++ mkHandle, mkFileHandle, mkDuplexHandle,+ openTextEncoding, initBufferState,+ dEFAULT_CHAR_BUFFER_SIZE,++ flushBuffer, flushWriteBuffer, flushWriteBuffer_, flushCharReadBuffer,+ flushCharBuffer, flushByteReadBuffer,++ readTextDevice, writeTextDevice, readTextDeviceNonBlocking,++ augmentIOError,+ ioe_closedHandle, ioe_EOF, ioe_notReadable, ioe_notWritable,+ ioe_finalizedHandle, ioe_bufsiz,++ hClose_help, hLookAhead_,++ HandleFinalizer, handleFinalizer,++ debugIO,+ ) where++import GHC.IO+import GHC.IO.IOMode+import GHC.IO.Encoding+import GHC.IO.Handle.Types+import GHC.IO.Buffer+import GHC.IO.BufferedIO (BufferedIO)+import GHC.IO.Exception+import GHC.IO.Device (IODevice, SeekMode(..))+import qualified GHC.IO.Device as IODevice+import qualified GHC.IO.BufferedIO as Buffered++import GHC.Real+import GHC.Base+import GHC.Exception+import GHC.Num ( Num(..) )+import GHC.Show+import GHC.IORef+import GHC.MVar+import Data.Typeable+import Control.Monad+import Data.Maybe+import Foreign+-- import System.IO.Error+import System.Posix.Internals hiding (FD)++#ifdef DEBUG_DUMP+import Foreign.C+#endif++-- ---------------------------------------------------------------------------+-- Creating a new handle++type HandleFinalizer = FilePath -> MVar Handle__ -> IO ()++newFileHandle :: FilePath -> Maybe HandleFinalizer -> Handle__ -> IO Handle+newFileHandle filepath mb_finalizer hc = do+ m <- newMVar hc+ case mb_finalizer of+ Just finalizer -> addMVarFinalizer m (finalizer filepath m)+ Nothing -> return ()+ return (FileHandle filepath m)++-- ---------------------------------------------------------------------------+-- Working with Handles++{-+In the concurrent world, handles are locked during use. This is done+by wrapping an MVar around the handle which acts as a mutex over+operations on the handle.++To avoid races, we use the following bracketing operations. The idea+is to obtain the lock, do some operation and replace the lock again,+whether the operation succeeded or failed. We also want to handle the+case where the thread receives an exception while processing the IO+operation: in these cases we also want to relinquish the lock.++There are three versions of @withHandle@: corresponding to the three+possible combinations of:++ - the operation may side-effect the handle+ - the operation may return a result++If the operation generates an error or an exception is raised, the+original handle is always replaced.+-}++{-# INLINE withHandle #-}+withHandle :: String -> Handle -> (Handle__ -> IO (Handle__,a)) -> IO a+withHandle fun h@(FileHandle _ m) act = withHandle' fun h m act+withHandle fun h@(DuplexHandle _ m _) act = withHandle' fun h m act++withHandle' :: String -> Handle -> MVar Handle__+ -> (Handle__ -> IO (Handle__,a)) -> IO a+withHandle' fun h m act =+ block $ do+ h_ <- takeMVar m+ checkHandleInvariants h_+ (h',v) <- (act h_ `catchAny` \err -> putMVar m h_ >> throw err)+ `catchException` \ex -> ioError (augmentIOError ex fun h)+ checkHandleInvariants h'+ putMVar m h'+ return v++{-# INLINE withHandle_ #-}+withHandle_ :: String -> Handle -> (Handle__ -> IO a) -> IO a+withHandle_ fun h@(FileHandle _ m) act = withHandle_' fun h m act+withHandle_ fun h@(DuplexHandle _ m _) act = withHandle_' fun h m act++withHandle_' :: String -> Handle -> MVar Handle__ -> (Handle__ -> IO a) -> IO a+withHandle_' fun h m act =+ block $ do+ h_ <- takeMVar m+ checkHandleInvariants h_+ v <- (act h_ `catchAny` \err -> putMVar m h_ >> throw err)+ `catchException` \ex -> ioError (augmentIOError ex fun h)+ checkHandleInvariants h_+ putMVar m h_+ return v++withAllHandles__ :: String -> Handle -> (Handle__ -> IO Handle__) -> IO ()+withAllHandles__ fun h@(FileHandle _ m) act = withHandle__' fun h m act+withAllHandles__ fun h@(DuplexHandle _ r w) act = do+ withHandle__' fun h r act+ withHandle__' fun h w act++withHandle__' :: String -> Handle -> MVar Handle__ -> (Handle__ -> IO Handle__)+ -> IO ()+withHandle__' fun h m act =+ block $ do+ h_ <- takeMVar m+ checkHandleInvariants h_+ h' <- (act h_ `catchAny` \err -> putMVar m h_ >> throw err)+ `catchException` \ex -> ioError (augmentIOError ex fun h)+ checkHandleInvariants h'+ putMVar m h'+ return ()++augmentIOError :: IOException -> String -> Handle -> IOException+augmentIOError ioe@IOError{ ioe_filename = fp } fun h+ = ioe { ioe_handle = Just h, ioe_location = fun, ioe_filename = filepath }+ where filepath+ | Just _ <- fp = fp+ | otherwise = case h of+ FileHandle path _ -> Just path+ DuplexHandle path _ _ -> Just path++-- ---------------------------------------------------------------------------+-- Wrapper for write operations.++wantWritableHandle :: String -> Handle -> (Handle__ -> IO a) -> IO a+wantWritableHandle fun h@(FileHandle _ m) act+ = wantWritableHandle' fun h m act+wantWritableHandle fun h@(DuplexHandle _ _ m) act+ = withHandle_' fun h m act++wantWritableHandle'+ :: String -> Handle -> MVar Handle__+ -> (Handle__ -> IO a) -> IO a+wantWritableHandle' fun h m act+ = withHandle_' fun h m (checkWritableHandle act)++checkWritableHandle :: (Handle__ -> IO a) -> Handle__ -> IO a+checkWritableHandle act h_@Handle__{..}+ = case haType of+ ClosedHandle -> ioe_closedHandle+ SemiClosedHandle -> ioe_closedHandle+ ReadHandle -> ioe_notWritable+ ReadWriteHandle -> do+ buf <- readIORef haCharBuffer+ when (not (isWriteBuffer buf)) $ do+ flushCharReadBuffer h_+ flushByteReadBuffer h_+ buf <- readIORef haCharBuffer+ writeIORef haCharBuffer buf{ bufState = WriteBuffer }+ buf <- readIORef haByteBuffer+ buf' <- Buffered.emptyWriteBuffer haDevice buf+ writeIORef haByteBuffer buf'+ act h_+ _other -> act h_++-- ---------------------------------------------------------------------------+-- Wrapper for read operations.++wantReadableHandle :: String -> Handle -> (Handle__ -> IO (Handle__,a)) -> IO a+wantReadableHandle fun h act = withHandle fun h (checkReadableHandle act)++wantReadableHandle_ :: String -> Handle -> (Handle__ -> IO a) -> IO a+wantReadableHandle_ fun h@(FileHandle _ m) act+ = wantReadableHandle' fun h m act+wantReadableHandle_ fun h@(DuplexHandle _ m _) act+ = withHandle_' fun h m act++wantReadableHandle'+ :: String -> Handle -> MVar Handle__+ -> (Handle__ -> IO a) -> IO a+wantReadableHandle' fun h m act+ = withHandle_' fun h m (checkReadableHandle act)++checkReadableHandle :: (Handle__ -> IO a) -> Handle__ -> IO a+checkReadableHandle act h_@Handle__{..} =+ case haType of+ ClosedHandle -> ioe_closedHandle+ SemiClosedHandle -> ioe_closedHandle+ AppendHandle -> ioe_notReadable+ WriteHandle -> ioe_notReadable+ ReadWriteHandle -> do+ -- a read/write handle and we want to read from it. We must+ -- flush all buffered write data first.+ cbuf <- readIORef haCharBuffer+ when (isWriteBuffer cbuf) $ do+ cbuf' <- flushWriteBuffer_ h_ cbuf+ writeIORef haCharBuffer cbuf'{ bufState = ReadBuffer }+ bbuf <- readIORef haByteBuffer+ writeIORef haByteBuffer bbuf{ bufState = ReadBuffer }+ act h_+ _other -> act h_++-- ---------------------------------------------------------------------------+-- Wrapper for seek operations.++wantSeekableHandle :: String -> Handle -> (Handle__ -> IO a) -> IO a+wantSeekableHandle fun h@(DuplexHandle _ _ _) _act =+ ioException (IOError (Just h) IllegalOperation fun+ "handle is not seekable" Nothing Nothing)+wantSeekableHandle fun h@(FileHandle _ m) act =+ withHandle_' fun h m (checkSeekableHandle act)++checkSeekableHandle :: (Handle__ -> IO a) -> Handle__ -> IO a+checkSeekableHandle act handle_@Handle__{haDevice=dev} =+ case haType handle_ of+ ClosedHandle -> ioe_closedHandle+ SemiClosedHandle -> ioe_closedHandle+ AppendHandle -> ioe_notSeekable+ _ -> do b <- IODevice.isSeekable dev+ if b then act handle_+ else ioe_notSeekable++-- -----------------------------------------------------------------------------+-- Handy IOErrors++ioe_closedHandle, ioe_EOF,+ ioe_notReadable, ioe_notWritable, ioe_cannotFlushNotSeekable,+ ioe_notSeekable, ioe_invalidCharacter :: IO a++ioe_closedHandle = ioException+ (IOError Nothing IllegalOperation ""+ "handle is closed" Nothing Nothing)+ioe_EOF = ioException+ (IOError Nothing EOF "" "" Nothing Nothing)+ioe_notReadable = ioException+ (IOError Nothing IllegalOperation ""+ "handle is not open for reading" Nothing Nothing)+ioe_notWritable = ioException+ (IOError Nothing IllegalOperation ""+ "handle is not open for writing" Nothing Nothing)+ioe_notSeekable = ioException+ (IOError Nothing IllegalOperation ""+ "handle is not seekable" Nothing Nothing)+ioe_cannotFlushNotSeekable = ioException+ (IOError Nothing IllegalOperation ""+ "cannot flush the read buffer: underlying device is not seekable"+ Nothing Nothing)+ioe_invalidCharacter = ioException+ (IOError Nothing InvalidArgument ""+ ("invalid byte sequence for this encoding") Nothing Nothing)++ioe_finalizedHandle :: FilePath -> Handle__+ioe_finalizedHandle fp = throw+ (IOError Nothing IllegalOperation ""+ "handle is finalized" Nothing (Just fp))++ioe_bufsiz :: Int -> IO a+ioe_bufsiz n = ioException+ (IOError Nothing InvalidArgument "hSetBuffering"+ ("illegal buffer size " ++ showsPrec 9 n []) Nothing Nothing)+ -- 9 => should be parens'ified.++-- -----------------------------------------------------------------------------+-- Handle Finalizers++-- For a duplex handle, we arrange that the read side points to the write side+-- (and hence keeps it alive if the read side is alive). This is done by+-- having the haOtherSide field of the read side point to the read side.+-- The finalizer is then placed on the write side, and the handle only gets+-- finalized once, when both sides are no longer required.++-- NOTE about finalized handles: It's possible that a handle can be+-- finalized and then we try to use it later, for example if the+-- handle is referenced from another finalizer, or from a thread that+-- has become unreferenced and then resurrected (arguably in the+-- latter case we shouldn't finalize the Handle...). Anyway,+-- we try to emit a helpful message which is better than nothing.++handleFinalizer :: FilePath -> MVar Handle__ -> IO ()+handleFinalizer fp m = do+ handle_ <- takeMVar m+ case haType handle_ of+ ClosedHandle -> return ()+ _ -> do flushWriteBuffer handle_ `catchAny` \_ -> return ()+ -- ignore errors and async exceptions, and close the+ -- descriptor anyway...+ _ <- hClose_handle_ handle_+ return ()+ putMVar m (ioe_finalizedHandle fp)++-- ---------------------------------------------------------------------------+-- Allocating buffers++-- using an 8k char buffer instead of 32k improved performance for a+-- basic "cat" program by ~30% for me. --SDM+dEFAULT_CHAR_BUFFER_SIZE :: Int+dEFAULT_CHAR_BUFFER_SIZE = dEFAULT_BUFFER_SIZE `div` 4++getCharBuffer :: IODevice dev => dev -> BufferState+ -> IO (IORef CharBuffer, BufferMode)+getCharBuffer dev state = do+ buffer <- newCharBuffer dEFAULT_CHAR_BUFFER_SIZE state+ ioref <- newIORef buffer+ is_tty <- IODevice.isTerminal dev++ let buffer_mode + | is_tty = LineBuffering + | otherwise = BlockBuffering Nothing++ return (ioref, buffer_mode)++mkUnBuffer :: BufferState -> IO (IORef CharBuffer, BufferMode)+mkUnBuffer state = do+ buffer <- case state of -- See [note Buffer Sizing], GHC.IO.Handle.Types+ ReadBuffer -> newCharBuffer dEFAULT_CHAR_BUFFER_SIZE state+ WriteBuffer -> newCharBuffer 1 state+ ref <- newIORef buffer+ return (ref, NoBuffering)++-- -----------------------------------------------------------------------------+-- Flushing buffers++-- | syncs the file with the buffer, including moving the+-- file pointer backwards in the case of a read buffer. This can fail+-- on a non-seekable read Handle.+flushBuffer :: Handle__ -> IO ()+flushBuffer h_@Handle__{..} = do+ buf <- readIORef haCharBuffer+ case bufState buf of+ ReadBuffer -> do+ flushCharReadBuffer h_+ flushByteReadBuffer h_+ WriteBuffer -> do+ buf' <- flushWriteBuffer_ h_ buf+ writeIORef haCharBuffer buf'++-- | flushes at least the Char buffer, and the byte buffer for a write+-- Handle. Works on all Handles.+flushCharBuffer :: Handle__ -> IO ()+flushCharBuffer h_@Handle__{..} = do+ buf <- readIORef haCharBuffer+ case bufState buf of+ ReadBuffer -> do+ flushCharReadBuffer h_+ WriteBuffer -> do+ buf' <- flushWriteBuffer_ h_ buf+ writeIORef haCharBuffer buf'++-- -----------------------------------------------------------------------------+-- Writing data (flushing write buffers)++-- flushWriteBuffer flushes the buffer iff it contains pending write+-- data. Flushes both the Char and the byte buffer, leaving both+-- empty.+flushWriteBuffer :: Handle__ -> IO ()+flushWriteBuffer h_@Handle__{..} = do+ buf <- readIORef haCharBuffer+ if isWriteBuffer buf+ then do buf' <- flushWriteBuffer_ h_ buf+ writeIORef haCharBuffer buf'+ else return ()++flushWriteBuffer_ :: Handle__ -> CharBuffer -> IO CharBuffer+flushWriteBuffer_ h_@Handle__{..} cbuf = do+ bbuf <- readIORef haByteBuffer+ if not (isEmptyBuffer cbuf) || not (isEmptyBuffer bbuf)+ then do writeTextDevice h_ cbuf+ return cbuf{ bufL=0, bufR=0 }+ else return cbuf++-- -----------------------------------------------------------------------------+-- Flushing read buffers++-- It is always possible to flush the Char buffer back to the byte buffer.+flushCharReadBuffer :: Handle__ -> IO ()+flushCharReadBuffer Handle__{..} = do+ cbuf <- readIORef haCharBuffer+ if isWriteBuffer cbuf || isEmptyBuffer cbuf then return () else do++ -- haLastDecode is the byte buffer just before we did our last batch of+ -- decoding. We're going to re-decode the bytes up to the current char,+ -- to find out where we should revert the byte buffer to.+ (codec_state, bbuf0) <- readIORef haLastDecode++ cbuf0 <- readIORef haCharBuffer+ writeIORef haCharBuffer cbuf0{ bufL=0, bufR=0 }++ -- if we haven't used any characters from the char buffer, then just+ -- re-install the old byte buffer.+ if bufL cbuf0 == 0+ then do writeIORef haByteBuffer bbuf0+ return ()+ else do++ case haDecoder of+ Nothing -> do+ writeIORef haByteBuffer bbuf0 { bufL = bufL bbuf0 + bufL cbuf0 }+ -- no decoder: the number of bytes to decode is the same as the+ -- number of chars we have used up.++ Just decoder -> do+ debugIO ("flushCharReadBuffer re-decode, bbuf=" ++ summaryBuffer bbuf0 +++ " cbuf=" ++ summaryBuffer cbuf0)++ -- restore the codec state+ setState decoder codec_state+ + (bbuf1,cbuf1) <- (encode decoder) bbuf0+ cbuf0{ bufL=0, bufR=0, bufSize = bufL cbuf0 }+ + debugIO ("finished, bbuf=" ++ summaryBuffer bbuf1 +++ " cbuf=" ++ summaryBuffer cbuf1)++ writeIORef haByteBuffer bbuf1+++-- When flushing the byte read buffer, we seek backwards by the number+-- of characters in the buffer. The file descriptor must therefore be+-- seekable: attempting to flush the read buffer on an unseekable+-- handle is not allowed.++flushByteReadBuffer :: Handle__ -> IO ()+flushByteReadBuffer h_@Handle__{..} = do+ bbuf <- readIORef haByteBuffer++ if isEmptyBuffer bbuf then return () else do++ seekable <- IODevice.isSeekable haDevice+ when (not seekable) $ ioe_cannotFlushNotSeekable++ let seek = negate (bufR bbuf - bufL bbuf)++ debugIO ("flushByteReadBuffer: new file offset = " ++ show seek)+ IODevice.seek haDevice RelativeSeek (fromIntegral seek)++ writeIORef haByteBuffer bbuf{ bufL=0, bufR=0 }++-- ----------------------------------------------------------------------------+-- Making Handles++mkHandle :: (IODevice dev, BufferedIO dev, Typeable dev) => dev+ -> FilePath+ -> HandleType+ -> Bool -- buffered?+ -> Maybe TextEncoding+ -> NewlineMode+ -> Maybe HandleFinalizer+ -> Maybe (MVar Handle__)+ -> IO Handle++mkHandle dev filepath ha_type buffered mb_codec nl finalizer other_side = do+ openTextEncoding mb_codec ha_type $ \ mb_encoder mb_decoder -> do++ let buf_state = initBufferState ha_type+ bbuf <- Buffered.newBuffer dev buf_state+ bbufref <- newIORef bbuf+ last_decode <- newIORef (error "codec_state", bbuf)++ (cbufref,bmode) <- + if buffered then getCharBuffer dev buf_state+ else mkUnBuffer buf_state++ spares <- newIORef BufferListNil+ newFileHandle filepath finalizer+ (Handle__ { haDevice = dev,+ haType = ha_type,+ haBufferMode = bmode,+ haByteBuffer = bbufref,+ haLastDecode = last_decode,+ haCharBuffer = cbufref,+ haBuffers = spares,+ haEncoder = mb_encoder,+ haDecoder = mb_decoder,+ haCodec = mb_codec,+ haInputNL = inputNL nl,+ haOutputNL = outputNL nl,+ haOtherSide = other_side+ })++-- | makes a new 'Handle'+mkFileHandle :: (IODevice dev, BufferedIO dev, Typeable dev)+ => dev -- ^ the underlying IO device, which must support + -- 'IODevice', 'BufferedIO' and 'Typeable'+ -> FilePath+ -- ^ a string describing the 'Handle', e.g. the file+ -- path for a file. Used in error messages.+ -> IOMode+ -- The mode in which the 'Handle' is to be used+ -> Maybe TextEncoding+ -- Create the 'Handle' with no text encoding?+ -> NewlineMode+ -- Translate newlines?+ -> IO Handle+mkFileHandle dev filepath iomode mb_codec tr_newlines = do+ mkHandle dev filepath (ioModeToHandleType iomode) True{-buffered-} mb_codec+ tr_newlines+ (Just handleFinalizer) Nothing{-other_side-}++-- | like 'mkFileHandle', except that a 'Handle' is created with two+-- independent buffers, one for reading and one for writing. Used for+-- full-dupliex streams, such as network sockets.+mkDuplexHandle :: (IODevice dev, BufferedIO dev, Typeable dev) => dev+ -> FilePath -> Maybe TextEncoding -> NewlineMode -> IO Handle+mkDuplexHandle dev filepath mb_codec tr_newlines = do++ write_side@(FileHandle _ write_m) <- + mkHandle dev filepath WriteHandle True mb_codec+ tr_newlines+ (Just handleFinalizer)+ Nothing -- no othersie++ read_side@(FileHandle _ read_m) <- + mkHandle dev filepath ReadHandle True mb_codec+ tr_newlines+ Nothing -- no finalizer+ (Just write_m)++ return (DuplexHandle filepath read_m write_m)++ioModeToHandleType :: IOMode -> HandleType+ioModeToHandleType ReadMode = ReadHandle+ioModeToHandleType WriteMode = WriteHandle+ioModeToHandleType ReadWriteMode = ReadWriteHandle+ioModeToHandleType AppendMode = AppendHandle++initBufferState :: HandleType -> BufferState+initBufferState ReadHandle = ReadBuffer+initBufferState _ = WriteBuffer++openTextEncoding+ :: Maybe TextEncoding+ -> HandleType+ -> (forall es ds . Maybe (TextEncoder es) -> Maybe (TextDecoder ds) -> IO a)+ -> IO a++openTextEncoding Nothing ha_type cont = cont Nothing Nothing+openTextEncoding (Just TextEncoding{..}) ha_type cont = do+ mb_decoder <- if isReadableHandleType ha_type then do+ decoder <- mkTextDecoder+ return (Just decoder)+ else+ return Nothing+ mb_encoder <- if isWritableHandleType ha_type then do+ encoder <- mkTextEncoder+ return (Just encoder)+ else + return Nothing+ cont mb_encoder mb_decoder++-- ---------------------------------------------------------------------------+-- closing Handles++-- hClose_help is also called by lazyRead (in GHC.IO.Handle.Text) when+-- EOF is read or an IO error occurs on a lazy stream. The+-- semi-closed Handle is then closed immediately. We have to be+-- careful with DuplexHandles though: we have to leave the closing to+-- the finalizer in that case, because the write side may still be in+-- use.+hClose_help :: Handle__ -> IO (Handle__, Maybe SomeException)+hClose_help handle_ =+ case haType handle_ of + ClosedHandle -> return (handle_,Nothing)+ _ -> do mb_exc1 <- trymaybe $ flushWriteBuffer handle_ -- interruptible+ -- it is important that hClose doesn't fail and+ -- leave the Handle open (#3128), so we catch+ -- exceptions when flushing the buffer.+ (h_, mb_exc2) <- hClose_handle_ handle_+ return (h_, if isJust mb_exc1 then mb_exc1 else mb_exc2)+++trymaybe :: IO () -> IO (Maybe SomeException)+trymaybe io = (do io; return Nothing) `catchException` \e -> return (Just e)++hClose_handle_ :: Handle__ -> IO (Handle__, Maybe SomeException)+hClose_handle_ Handle__{..} = do++ -- close the file descriptor, but not when this is the read+ -- side of a duplex handle.+ -- If an exception is raised by the close(), we want to continue+ -- to close the handle and release the lock if it has one, then + -- we return the exception to the caller of hClose_help which can+ -- raise it if necessary.+ maybe_exception <- + case haOtherSide of+ Nothing -> trymaybe $ IODevice.close haDevice+ Just _ -> return Nothing++ -- free the spare buffers+ writeIORef haBuffers BufferListNil+ writeIORef haCharBuffer noCharBuffer+ writeIORef haByteBuffer noByteBuffer+ + -- release our encoder/decoder+ case haDecoder of Nothing -> return (); Just d -> close d+ case haEncoder of Nothing -> return (); Just d -> close d++ -- we must set the fd to -1, because the finalizer is going+ -- to run eventually and try to close/unlock it.+ -- ToDo: necessary? the handle will be marked ClosedHandle+ -- XXX GHC won't let us use record update here, hence wildcards+ return (Handle__{ haType = ClosedHandle, .. }, maybe_exception)++{-# NOINLINE noCharBuffer #-}+noCharBuffer :: CharBuffer+noCharBuffer = unsafePerformIO $ newCharBuffer 1 ReadBuffer++{-# NOINLINE noByteBuffer #-}+noByteBuffer :: Buffer Word8+noByteBuffer = unsafePerformIO $ newByteBuffer 1 ReadBuffer++-- ---------------------------------------------------------------------------+-- Looking ahead++hLookAhead_ :: Handle__ -> IO Char+hLookAhead_ handle_@Handle__{..} = do+ buf <- readIORef haCharBuffer+ + -- fill up the read buffer if necessary+ new_buf <- if isEmptyBuffer buf+ then readTextDevice handle_ buf+ else return buf+ writeIORef haCharBuffer new_buf+ + peekCharBuf (bufRaw buf) (bufL buf)++-- ---------------------------------------------------------------------------+-- debugging++debugIO :: String -> IO ()+#if defined(DEBUG_DUMP)+debugIO s = do + withCStringLen (s++"\n") $ \(p,len) -> c_write 1 (castPtr p) (fromIntegral len)+ return ()+#else+debugIO s = return ()+#endif++-- ----------------------------------------------------------------------------+-- Text input/output++-- Write the contents of the supplied Char buffer to the device, return+-- only when all the data has been written.+writeTextDevice :: Handle__ -> CharBuffer -> IO ()+writeTextDevice h_@Handle__{..} cbuf = do+ --+ bbuf <- readIORef haByteBuffer++ debugIO ("writeTextDevice: cbuf=" ++ summaryBuffer cbuf ++ + " bbuf=" ++ summaryBuffer bbuf)++ (cbuf',bbuf') <- case haEncoder of+ Nothing -> latin1_encode cbuf bbuf+ Just encoder -> (encode encoder) cbuf bbuf++ debugIO ("writeTextDevice after encoding: cbuf=" ++ summaryBuffer cbuf' ++ + " bbuf=" ++ summaryBuffer bbuf')++ bbuf' <- Buffered.flushWriteBuffer haDevice bbuf'+ writeIORef haByteBuffer bbuf'+ if not (isEmptyBuffer cbuf')+ then writeTextDevice h_ cbuf'+ else return ()++-- Read characters into the provided buffer. Return when any+-- characters are available; raise an exception if the end of +-- file is reached.+readTextDevice :: Handle__ -> CharBuffer -> IO CharBuffer+readTextDevice h_@Handle__{..} cbuf = do+ --+ bbuf0 <- readIORef haByteBuffer++ debugIO ("readTextDevice: cbuf=" ++ summaryBuffer cbuf ++ + " bbuf=" ++ summaryBuffer bbuf0)++ bbuf1 <- if not (isEmptyBuffer bbuf0)+ then return bbuf0+ else do+ (r,bbuf1) <- Buffered.fillReadBuffer haDevice bbuf0+ if r == 0 then ioe_EOF else do -- raise EOF+ return bbuf1++ debugIO ("readTextDevice after reading: bbuf=" ++ summaryBuffer bbuf1)++ (bbuf2,cbuf') <- + case haDecoder of+ Nothing -> do+ writeIORef haLastDecode (error "codec_state", bbuf1)+ latin1_decode bbuf1 cbuf+ Just decoder -> do+ state <- getState decoder+ writeIORef haLastDecode (state, bbuf1)+ (encode decoder) bbuf1 cbuf++ debugIO ("readTextDevice after decoding: cbuf=" ++ summaryBuffer cbuf' ++ + " bbuf=" ++ summaryBuffer bbuf2)++ writeIORef haByteBuffer bbuf2+ if bufR cbuf' == bufR cbuf -- no new characters+ then readTextDevice' h_ bbuf2 cbuf -- we need more bytes to make a Char+ else return cbuf'++-- we have an incomplete byte sequence at the end of the buffer: try to+-- read more bytes.+readTextDevice' :: Handle__ -> Buffer Word8 -> CharBuffer -> IO CharBuffer+readTextDevice' h_@Handle__{..} bbuf0 cbuf = do+ --+ -- copy the partial sequence to the beginning of the buffer, so we have+ -- room to read more bytes.+ bbuf1 <- slideContents bbuf0++ bbuf2 <- do (r,bbuf2) <- Buffered.fillReadBuffer haDevice bbuf1+ if r == 0 + then ioe_invalidCharacter+ else return bbuf2++ debugIO ("readTextDevice after reading: bbuf=" ++ summaryBuffer bbuf2)++ (bbuf3,cbuf') <- + case haDecoder of+ Nothing -> do+ writeIORef haLastDecode (error "codec_state", bbuf2)+ latin1_decode bbuf2 cbuf+ Just decoder -> do+ state <- getState decoder+ writeIORef haLastDecode (state, bbuf2)+ (encode decoder) bbuf2 cbuf++ debugIO ("readTextDevice after decoding: cbuf=" ++ summaryBuffer cbuf' ++ + " bbuf=" ++ summaryBuffer bbuf3)++ writeIORef haByteBuffer bbuf3+ if bufR cbuf == bufR cbuf'+ then readTextDevice' h_ bbuf3 cbuf'+ else return cbuf'++-- Read characters into the provided buffer. Do not block;+-- return zero characters instead. Raises an exception on end-of-file.+readTextDeviceNonBlocking :: Handle__ -> CharBuffer -> IO CharBuffer+readTextDeviceNonBlocking h_@Handle__{..} cbuf = do+ --+ bbuf0 <- readIORef haByteBuffer+ bbuf1 <- if not (isEmptyBuffer bbuf0)+ then return bbuf0+ else do+ (r,bbuf1) <- Buffered.fillReadBuffer0 haDevice bbuf0+ if isNothing r then ioe_EOF else do -- raise EOF+ return bbuf1++ (bbuf2,cbuf') <-+ case haDecoder of+ Nothing -> do+ writeIORef haLastDecode (error "codec_state", bbuf1)+ latin1_decode bbuf1 cbuf+ Just decoder -> do+ state <- getState decoder+ writeIORef haLastDecode (state, bbuf1)+ (encode decoder) bbuf1 cbuf++ writeIORef haByteBuffer bbuf2+ return cbuf'
+ GHC/IO/Handle/Text.hs view
@@ -0,0 +1,987 @@+{-# OPTIONS_GHC -XNoImplicitPrelude -#include "HsBase.h" #-}+{-# OPTIONS_GHC -XRecordWildCards -XBangPatterns #-}+{-# OPTIONS_GHC -fno-warn-name-shadowing #-}+{-# OPTIONS_GHC -fno-warn-unused-matches #-}+{-# OPTIONS_HADDOCK hide #-}++-----------------------------------------------------------------------------+-- |+-- Module : GHC.IO.Text+-- Copyright : (c) The University of Glasgow, 1992-2008+-- License : see libraries/base/LICENSE+-- +-- Maintainer : libraries@haskell.org+-- Stability : internal+-- Portability : non-portable+--+-- String I\/O functions+--+-----------------------------------------------------------------------------++-- #hide+module GHC.IO.Handle.Text ( + hWaitForInput, hGetChar, hGetLine, hGetContents, hPutChar, hPutStr,+ commitBuffer', -- hack, see below+ hGetBuf, hGetBufNonBlocking, hPutBuf, hPutBufNonBlocking,+ memcpy,+ ) where++import GHC.IO+import GHC.IO.FD+import GHC.IO.Buffer+import qualified GHC.IO.BufferedIO as Buffered+import GHC.IO.Exception+import GHC.Exception+import GHC.IO.Handle.Types+import GHC.IO.Handle.Internals+import qualified GHC.IO.Device as IODevice+import qualified GHC.IO.Device as RawIO++import Foreign+import Foreign.C++import Data.Typeable+import System.IO.Error+import Data.Maybe+import Control.Monad++import GHC.IORef+import GHC.Base+import GHC.Real+import GHC.Num+import GHC.Show+import GHC.List++-- ---------------------------------------------------------------------------+-- Simple input operations++-- If hWaitForInput finds anything in the Handle's buffer, it+-- immediately returns. If not, it tries to read from the underlying+-- OS handle. Notice that for buffered Handles connected to terminals+-- this means waiting until a complete line is available.++-- | Computation 'hWaitForInput' @hdl t@+-- waits until input is available on handle @hdl@.+-- It returns 'True' as soon as input is available on @hdl@,+-- or 'False' if no input is available within @t@ milliseconds.+--+-- If @t@ is less than zero, then @hWaitForInput@ waits indefinitely.+--+-- This operation may fail with:+--+-- * 'isEOFError' if the end of file has been reached.+--+-- NOTE for GHC users: unless you use the @-threaded@ flag,+-- @hWaitForInput t@ where @t >= 0@ will block all other Haskell+-- threads for the duration of the call. It behaves like a+-- @safe@ foreign call in this respect.++hWaitForInput :: Handle -> Int -> IO Bool+hWaitForInput h msecs = do+ wantReadableHandle_ "hWaitForInput" h $ \ handle_@Handle__{..} -> do+ cbuf <- readIORef haCharBuffer++ if not (isEmptyBuffer cbuf) then return True else do++ if msecs < 0 + then do cbuf' <- readTextDevice handle_ cbuf+ writeIORef haCharBuffer cbuf'+ return True+ else do+ -- there might be bytes in the byte buffer waiting to be decoded+ cbuf' <- readTextDeviceNonBlocking handle_ cbuf+ writeIORef haCharBuffer cbuf'++ if not (isEmptyBuffer cbuf') then return True else do++ r <- IODevice.ready haDevice False{-read-} msecs+ if r then do -- Call hLookAhead' to throw an EOF+ -- exception if appropriate+ _ <- hLookAhead_ handle_+ return True+ else return False+ -- XXX we should only return when there are full characters+ -- not when there are only bytes. That would mean looping+ -- and re-running IODevice.ready if we don't have any full+ -- characters; but we don't know how long we've waited+ -- so far.++-- ---------------------------------------------------------------------------+-- hGetChar++-- | Computation 'hGetChar' @hdl@ reads a character from the file or+-- channel managed by @hdl@, blocking until a character is available.+--+-- This operation may fail with:+--+-- * 'isEOFError' if the end of file has been reached.++hGetChar :: Handle -> IO Char+hGetChar handle =+ wantReadableHandle_ "hGetChar" handle $ \handle_@Handle__{..} -> do++ -- buffering mode makes no difference: we just read whatever is available+ -- from the device (blocking only if there is nothing available), and then+ -- return the first character.+ -- See [note Buffered Reading] in GHC.IO.Handle.Types+ buf0 <- readIORef haCharBuffer++ buf1 <- if isEmptyBuffer buf0+ then readTextDevice handle_ buf0+ else return buf0++ (c1,i) <- readCharBuf (bufRaw buf1) (bufL buf1)+ let buf2 = bufferAdjustL i buf1++ if haInputNL == CRLF && c1 == '\r'+ then do+ mbuf3 <- if isEmptyBuffer buf2+ then maybeFillReadBuffer handle_ buf2+ else return (Just buf2)++ case mbuf3 of+ -- EOF, so just return the '\r' we have+ Nothing -> do+ writeIORef haCharBuffer buf2+ return '\r'+ Just buf3 -> do+ (c2,i2) <- readCharBuf (bufRaw buf2) (bufL buf2)+ if c2 == '\n'+ then do+ writeIORef haCharBuffer (bufferAdjustL i2 buf3)+ return '\n'+ else do+ -- not a \r\n sequence, so just return the \r+ writeIORef haCharBuffer buf3+ return '\r'+ else do+ writeIORef haCharBuffer buf2+ return c1++-- ---------------------------------------------------------------------------+-- hGetLine++-- ToDo: the unbuffered case is wrong: it doesn't lock the handle for+-- the duration.++-- | Computation 'hGetLine' @hdl@ reads a line from the file or+-- channel managed by @hdl@.+--+-- This operation may fail with:+--+-- * 'isEOFError' if the end of file is encountered when reading+-- the /first/ character of the line.+--+-- If 'hGetLine' encounters end-of-file at any other point while reading+-- in a line, it is treated as a line terminator and the (partial)+-- line is returned.++hGetLine :: Handle -> IO String+hGetLine h =+ wantReadableHandle_ "hGetLine" h $ \ handle_ -> do+ hGetLineBuffered handle_++hGetLineBuffered :: Handle__ -> IO String+hGetLineBuffered handle_@Handle__{..} = do+ buf <- readIORef haCharBuffer+ hGetLineBufferedLoop handle_ buf []++hGetLineBufferedLoop :: Handle__+ -> CharBuffer -> [String]+ -> IO String+hGetLineBufferedLoop handle_@Handle__{..}+ buf@Buffer{ bufL=r0, bufR=w, bufRaw=raw0 } xss =+ let+ -- find the end-of-line character, if there is one+ loop raw r+ | r == w = return (False, w)+ | otherwise = do+ (c,r') <- readCharBuf raw r+ if c == '\n'+ then return (True, r) -- NB. not r': don't include the '\n'+ else loop raw r'+ in do+ (eol, off) <- loop raw0 r0++ debugIO ("hGetLineBufferedLoop: r=" ++ show r0 ++ ", w=" ++ show w ++ ", off=" ++ show off)++ (xs,r') <- if haInputNL == CRLF+ then unpack_nl raw0 r0 off ""+ else do xs <- unpack raw0 r0 off ""+ return (xs,off)++ -- if eol == True, then off is the offset of the '\n'+ -- otherwise off == w and the buffer is now empty.+ if eol -- r' == off+ then do writeIORef haCharBuffer (bufferAdjustL (off+1) buf)+ return (concat (reverse (xs:xss)))+ else do+ let buf1 = bufferAdjustL r' buf+ maybe_buf <- maybeFillReadBuffer handle_ buf1+ case maybe_buf of+ -- Nothing indicates we caught an EOF, and we may have a+ -- partial line to return.+ Nothing -> do+ -- we reached EOF. There might be a lone \r left+ -- in the buffer, so check for that and+ -- append it to the line if necessary.+ -- + let pre = if not (isEmptyBuffer buf1) then "\r" else ""+ writeIORef haCharBuffer buf1{ bufL=0, bufR=0 }+ let str = concat (reverse (pre:xs:xss))+ if not (null str)+ then return str+ else ioe_EOF+ Just new_buf ->+ hGetLineBufferedLoop handle_ new_buf (xs:xss)++maybeFillReadBuffer :: Handle__ -> CharBuffer -> IO (Maybe CharBuffer)+maybeFillReadBuffer handle_ buf+ = catch + (do buf' <- getSomeCharacters handle_ buf+ return (Just buf')+ )+ (\e -> do if isEOFError e + then return Nothing + else ioError e)++-- See GHC.IO.Buffer+#define CHARBUF_UTF32+-- #define CHARBUF_UTF16++-- NB. performance-critical code: eyeball the Core.+unpack :: RawCharBuffer -> Int -> Int -> [Char] -> IO [Char]+unpack !buf !r !w acc0+ | r == w = return acc0+ | otherwise = + withRawBuffer buf $ \pbuf -> + let+ unpackRB acc !i+ | i < r = return acc+ | otherwise = do+#ifdef CHARBUF_UTF16+ -- reverse-order decoding of UTF-16+ c2 <- peekElemOff pbuf i+ if (c2 < 0xdc00 || c2 > 0xdffff)+ then unpackRB (unsafeChr (fromIntegral c2) : acc) (i-1)+ else do c1 <- peekElemOff pbuf (i-1)+ let c = (fromIntegral c1 - 0xd800) * 0x400 ++ (fromIntegral c2 - 0xdc00) + 0x10000+ unpackRB (unsafeChr c : acc) (i-2)+#else+ c <- peekElemOff pbuf i+ unpackRB (c:acc) (i-1)+#endif+ in+ unpackRB acc0 (w-1)++-- NB. performance-critical code: eyeball the Core.+unpack_nl :: RawCharBuffer -> Int -> Int -> [Char] -> IO ([Char],Int)+unpack_nl !buf !r !w acc0+ | r == w = return (acc0, 0)+ | otherwise =+ withRawBuffer buf $ \pbuf ->+ let+ unpackRB acc !i+ | i < r = return acc+ | otherwise = do+ c <- peekElemOff pbuf i+ if (c == '\n' && i > r)+ then do+ c1 <- peekElemOff pbuf (i-1)+ if (c1 == '\r')+ then unpackRB ('\n':acc) (i-2)+ else unpackRB ('\n':acc) (i-1)+ else do+ unpackRB (c:acc) (i-1)+ in do+ c <- peekElemOff pbuf (w-1)+ if (c == '\r')+ then do + -- If the last char is a '\r', we need to know whether or+ -- not it is followed by a '\n', so leave it in the buffer+ -- for now and just unpack the rest.+ str <- unpackRB acc0 (w-2)+ return (str, w-1)+ else do+ str <- unpackRB acc0 (w-1)+ return (str, w)+++-- -----------------------------------------------------------------------------+-- hGetContents++-- hGetContents on a DuplexHandle only affects the read side: you can+-- carry on writing to it afterwards.++-- | Computation 'hGetContents' @hdl@ returns the list of characters+-- corresponding to the unread portion of the channel or file managed+-- by @hdl@, which is put into an intermediate state, /semi-closed/.+-- In this state, @hdl@ is effectively closed,+-- but items are read from @hdl@ on demand and accumulated in a special+-- list returned by 'hGetContents' @hdl@.+--+-- Any operation that fails because a handle is closed,+-- also fails if a handle is semi-closed. The only exception is 'hClose'.+-- A semi-closed handle becomes closed:+--+-- * if 'hClose' is applied to it;+--+-- * if an I\/O error occurs when reading an item from the handle;+--+-- * or once the entire contents of the handle has been read.+--+-- Once a semi-closed handle becomes closed, the contents of the+-- associated list becomes fixed. The contents of this final list is+-- only partially specified: it will contain at least all the items of+-- the stream that were evaluated prior to the handle becoming closed.+--+-- Any I\/O errors encountered while a handle is semi-closed are simply+-- discarded.+--+-- This operation may fail with:+--+-- * 'isEOFError' if the end of file has been reached.++hGetContents :: Handle -> IO String+hGetContents handle = + wantReadableHandle "hGetContents" handle $ \handle_ -> do+ xs <- lazyRead handle+ return (handle_{ haType=SemiClosedHandle}, xs )++-- Note that someone may close the semi-closed handle (or change its+-- buffering), so each time these lazy read functions are pulled on,+-- they have to check whether the handle has indeed been closed.++lazyRead :: Handle -> IO String+lazyRead handle = + unsafeInterleaveIO $+ withHandle "hGetContents" handle $ \ handle_ -> do+ case haType handle_ of+ ClosedHandle -> return (handle_, "")+ SemiClosedHandle -> lazyReadBuffered handle handle_+ _ -> ioException + (IOError (Just handle) IllegalOperation "hGetContents"+ "illegal handle type" Nothing Nothing)++lazyReadBuffered :: Handle -> Handle__ -> IO (Handle__, [Char])+lazyReadBuffered h handle_@Handle__{..} = do+ buf <- readIORef haCharBuffer+ catch + (do + buf'@Buffer{..} <- getSomeCharacters handle_ buf+ lazy_rest <- lazyRead h+ (s,r) <- if haInputNL == CRLF+ then unpack_nl bufRaw bufL bufR lazy_rest+ else do s <- unpack bufRaw bufL bufR lazy_rest+ return (s,bufR)+ writeIORef haCharBuffer (bufferAdjustL r buf')+ return (handle_, s)+ )+ (\e -> do (handle_', _) <- hClose_help handle_+ debugIO ("hGetContents caught: " ++ show e)+ -- We might have a \r cached in CRLF mode. So we+ -- need to check for that and return it:+ let r = if isEOFError e+ then if not (isEmptyBuffer buf)+ then "\r"+ else ""+ else+ throw (augmentIOError e "hGetContents" h)++ return (handle_', r)+ )++-- ensure we have some characters in the buffer+getSomeCharacters :: Handle__ -> CharBuffer -> IO CharBuffer+getSomeCharacters handle_@Handle__{..} buf@Buffer{..} =+ case bufferElems buf of++ -- buffer empty: read some more+ 0 -> readTextDevice handle_ buf++ -- if the buffer has a single '\r' in it and we're doing newline+ -- translation: read some more+ 1 | haInputNL == CRLF -> do+ (c,_) <- readCharBuf bufRaw bufL+ if c == '\r'+ then do -- shuffle the '\r' to the beginning. This is only safe+ -- if we're about to call readTextDevice, otherwise it+ -- would mess up flushCharBuffer.+ -- See [note Buffer Flushing], GHC.IO.Handle.Types+ _ <- writeCharBuf bufRaw 0 '\r'+ let buf' = buf{ bufL=0, bufR=1 }+ readTextDevice handle_ buf'+ else do+ return buf++ -- buffer has some chars in it already: just return it+ _otherwise ->+ return buf++-- ---------------------------------------------------------------------------+-- hPutChar++-- | Computation 'hPutChar' @hdl ch@ writes the character @ch@ to the+-- file or channel managed by @hdl@. Characters may be buffered if+-- buffering is enabled for @hdl@.+--+-- This operation may fail with:+--+-- * 'isFullError' if the device is full; or+--+-- * 'isPermissionError' if another system resource limit would be exceeded.++hPutChar :: Handle -> Char -> IO ()+hPutChar handle c = do+ c `seq` return ()+ wantWritableHandle "hPutChar" handle $ \ handle_ -> do+ case haBufferMode handle_ of+ LineBuffering -> hPutcBuffered handle_ True c+ _other -> hPutcBuffered handle_ False c++hPutcBuffered :: Handle__ -> Bool -> Char -> IO ()+hPutcBuffered handle_@Handle__{..} is_line c = do+ buf <- readIORef haCharBuffer+ if c == '\n'+ then do buf1 <- if haOutputNL == CRLF+ then do+ buf1 <- putc buf '\r'+ putc buf1 '\n'+ else do+ putc buf '\n'+ if is_line + then do+ flushed_buf <- flushWriteBuffer_ handle_ buf1+ writeIORef haCharBuffer flushed_buf+ else+ writeIORef haCharBuffer buf1+ else do+ buf1 <- putc buf c+ writeIORef haCharBuffer buf1+ where+ putc buf@Buffer{ bufRaw=raw, bufR=w } c = do+ debugIO ("putc: " ++ summaryBuffer buf)+ w' <- writeCharBuf raw w c+ let buf' = buf{ bufR = w' }+ if isFullCharBuffer buf'+ then flushWriteBuffer_ handle_ buf'+ else return buf'++-- ---------------------------------------------------------------------------+-- hPutStr++-- We go to some trouble to avoid keeping the handle locked while we're+-- evaluating the string argument to hPutStr, in case doing so triggers another+-- I/O operation on the same handle which would lead to deadlock. The classic+-- case is+--+-- putStr (trace "hello" "world")+--+-- so the basic scheme is this:+--+-- * copy the string into a fresh buffer,+-- * "commit" the buffer to the handle.+--+-- Committing may involve simply copying the contents of the new+-- buffer into the handle's buffer, flushing one or both buffers, or+-- maybe just swapping the buffers over (if the handle's buffer was+-- empty). See commitBuffer below.++-- | Computation 'hPutStr' @hdl s@ writes the string+-- @s@ to the file or channel managed by @hdl@.+--+-- This operation may fail with:+--+-- * 'isFullError' if the device is full; or+--+-- * 'isPermissionError' if another system resource limit would be exceeded.++hPutStr :: Handle -> String -> IO ()+hPutStr handle str = do+ (buffer_mode, nl) <- + wantWritableHandle "hPutStr" handle $ \h_ -> do+ bmode <- getSpareBuffer h_+ return (bmode, haOutputNL h_)++ case buffer_mode of+ (NoBuffering, _) -> do+ hPutChars handle str -- v. slow, but we don't care+ (LineBuffering, buf) -> do+ writeBlocks handle True nl buf str+ (BlockBuffering _, buf) -> do+ writeBlocks handle False nl buf str++hPutChars :: Handle -> [Char] -> IO ()+hPutChars _ [] = return ()+hPutChars handle (c:cs) = hPutChar handle c >> hPutChars handle cs++getSpareBuffer :: Handle__ -> IO (BufferMode, CharBuffer)+getSpareBuffer Handle__{haCharBuffer=ref, + haBuffers=spare_ref,+ haBufferMode=mode}+ = do+ case mode of+ NoBuffering -> return (mode, error "no buffer!")+ _ -> do+ bufs <- readIORef spare_ref+ buf <- readIORef ref+ case bufs of+ BufferListCons b rest -> do+ writeIORef spare_ref rest+ return ( mode, emptyBuffer b (bufSize buf) WriteBuffer)+ BufferListNil -> do+ new_buf <- newCharBuffer (bufSize buf) WriteBuffer+ return (mode, new_buf)+++-- NB. performance-critical code: eyeball the Core.+writeBlocks :: Handle -> Bool -> Newline -> Buffer CharBufElem -> String -> IO ()+writeBlocks hdl line_buffered nl+ buf@Buffer{ bufRaw=raw, bufSize=len } s =+ let+ shoveString :: Int -> [Char] -> IO ()+ shoveString !n [] = do+ _ <- commitBuffer hdl raw len n False{-no flush-} True{-release-}+ return ()+ shoveString !n (c:cs)+ -- n+1 so we have enough room to write '\r\n' if necessary+ | n + 1 >= len = do+ new_buf <- commitBuffer hdl raw len n True{-needs flush-} False+ writeBlocks hdl line_buffered nl new_buf (c:cs)+ | c == '\n' = do+ n' <- if nl == CRLF+ then do + n1 <- writeCharBuf raw n '\r'+ writeCharBuf raw n1 '\n'+ else do+ writeCharBuf raw n c+ if line_buffered+ then do+ new_buf <- commitBuffer hdl raw len n' True{-needs flush-} False+ writeBlocks hdl line_buffered nl new_buf cs+ else do+ shoveString n' cs+ | otherwise = do+ n' <- writeCharBuf raw n c+ shoveString n' cs+ in+ shoveString 0 s++-- -----------------------------------------------------------------------------+-- commitBuffer handle buf sz count flush release+-- +-- Write the contents of the buffer 'buf' ('sz' bytes long, containing+-- 'count' bytes of data) to handle (handle must be block or line buffered).+-- +-- Implementation:+-- +-- for block/line buffering,+-- 1. If there isn't room in the handle buffer, flush the handle+-- buffer.+-- +-- 2. If the handle buffer is empty,+-- if flush, +-- then write buf directly to the device.+-- else swap the handle buffer with buf.+-- +-- 3. If the handle buffer is non-empty, copy buf into the+-- handle buffer. Then, if flush != 0, flush+-- the buffer.++commitBuffer+ :: Handle -- handle to commit to+ -> RawCharBuffer -> Int -- address and size (in bytes) of buffer+ -> Int -- number of bytes of data in buffer+ -> Bool -- True <=> flush the handle afterward+ -> Bool -- release the buffer?+ -> IO CharBuffer++commitBuffer hdl !raw !sz !count flush release = + wantWritableHandle "commitAndReleaseBuffer" hdl $+ commitBuffer' raw sz count flush release+{-# NOINLINE commitBuffer #-}++-- Explicitly lambda-lift this function to subvert GHC's full laziness+-- optimisations, which otherwise tends to float out subexpressions+-- past the \handle, which is really a pessimisation in this case because+-- that lambda is a one-shot lambda.+--+-- Don't forget to export the function, to stop it being inlined too+-- (this appears to be better than NOINLINE, because the strictness+-- analyser still gets to worker-wrapper it).+--+-- This hack is a fairly big win for hPutStr performance. --SDM 18/9/2001+--+commitBuffer' :: RawCharBuffer -> Int -> Int -> Bool -> Bool -> Handle__+ -> IO CharBuffer+commitBuffer' raw sz@(I# _) count@(I# _) flush release+ handle_@Handle__{ haCharBuffer=ref, haBuffers=spare_buf_ref } = do++ debugIO ("commitBuffer: sz=" ++ show sz ++ ", count=" ++ show count+ ++ ", flush=" ++ show flush ++ ", release=" ++ show release)++ old_buf@Buffer{ bufRaw=old_raw, bufR=w, bufSize=size }+ <- readIORef ref++ buf_ret <-+ -- enough room in handle buffer?+ if (not flush && (size - w > count))+ -- The > is to be sure that we never exactly fill+ -- up the buffer, which would require a flush. So+ -- if copying the new data into the buffer would+ -- make the buffer full, we just flush the existing+ -- buffer and the new data immediately, rather than+ -- copying before flushing.++ -- not flushing, and there's enough room in the buffer:+ -- just copy the data in and update bufR.+ then do withRawBuffer raw $ \praw ->+ copyToRawBuffer old_raw (w*charSize)+ praw (fromIntegral (count*charSize))+ writeIORef ref old_buf{ bufR = w + count }+ return (emptyBuffer raw sz WriteBuffer)++ -- else, we have to flush+ else do flushed_buf <- flushWriteBuffer_ handle_ old_buf++ let this_buf = + Buffer{ bufRaw=raw, bufState=WriteBuffer, + bufL=0, bufR=count, bufSize=sz }++ -- if: (a) we don't have to flush, and+ -- (b) size(new buffer) == size(old buffer), and+ -- (c) new buffer is not full,+ -- we can just just swap them over...+ if (not flush && sz == size && count /= sz)+ then do + writeIORef ref this_buf+ return flushed_buf ++ -- otherwise, we have to flush the new data too,+ -- and start with a fresh buffer+ else do+ -- We're aren't going to use this buffer again+ -- so we ignore the result of flushWriteBuffer_+ _ <- flushWriteBuffer_ handle_ this_buf+ writeIORef ref flushed_buf+ -- if the sizes were different, then allocate+ -- a new buffer of the correct size.+ if sz == size+ then return (emptyBuffer raw sz WriteBuffer)+ else newCharBuffer size WriteBuffer++ -- release the buffer if necessary+ case buf_ret of+ Buffer{ bufSize=buf_ret_sz, bufRaw=buf_ret_raw } -> do+ if release && buf_ret_sz == size+ then do+ spare_bufs <- readIORef spare_buf_ref+ writeIORef spare_buf_ref + (BufferListCons buf_ret_raw spare_bufs)+ return buf_ret+ else+ return buf_ret++-- ---------------------------------------------------------------------------+-- Reading/writing sequences of bytes.++-- ---------------------------------------------------------------------------+-- hPutBuf++-- | 'hPutBuf' @hdl buf count@ writes @count@ 8-bit bytes from the+-- buffer @buf@ to the handle @hdl@. It returns ().+--+-- 'hPutBuf' ignores any text encoding that applies to the 'Handle',+-- writing the bytes directly to the underlying file or device.+--+-- 'hPutBuf' ignores the prevailing 'TextEncoding' and+-- 'NewlineMode' on the 'Handle', and writes bytes directly.+--+-- This operation may fail with:+--+-- * 'ResourceVanished' if the handle is a pipe or socket, and the+-- reading end is closed. (If this is a POSIX system, and the program+-- has not asked to ignore SIGPIPE, then a SIGPIPE may be delivered+-- instead, whose default action is to terminate the program).++hPutBuf :: Handle -- handle to write to+ -> Ptr a -- address of buffer+ -> Int -- number of bytes of data in buffer+ -> IO ()+hPutBuf h ptr count = do _ <- hPutBuf' h ptr count True+ return ()++hPutBufNonBlocking+ :: Handle -- handle to write to+ -> Ptr a -- address of buffer+ -> Int -- number of bytes of data in buffer+ -> IO Int -- returns: number of bytes written+hPutBufNonBlocking h ptr count = hPutBuf' h ptr count False++hPutBuf':: Handle -- handle to write to+ -> Ptr a -- address of buffer+ -> Int -- number of bytes of data in buffer+ -> Bool -- allow blocking?+ -> IO Int+hPutBuf' handle ptr count can_block+ | count == 0 = return 0+ | count < 0 = illegalBufferSize handle "hPutBuf" count+ | otherwise = + wantWritableHandle "hPutBuf" handle $ + \ h_@Handle__{..} -> do+ debugIO ("hPutBuf count=" ++ show count)+ -- first flush the Char buffer if it is non-empty, then we+ -- can work directly with the byte buffer+ cbuf <- readIORef haCharBuffer+ when (not (isEmptyBuffer cbuf)) $ flushWriteBuffer h_++ r <- bufWrite h_ (castPtr ptr) count can_block++ -- we must flush if this Handle is set to NoBuffering. If+ -- it is set to LineBuffering, be conservative and flush+ -- anyway (we didn't check for newlines in the data).+ case haBufferMode of+ BlockBuffering _ -> do return ()+ _line_or_no_buffering -> do flushWriteBuffer h_+ return r++bufWrite :: Handle__-> Ptr Word8 -> Int -> Bool -> IO Int+bufWrite h_@Handle__{..} ptr count can_block =+ seq count $ do -- strictness hack+ old_buf@Buffer{ bufRaw=old_raw, bufR=w, bufSize=size }+ <- readIORef haByteBuffer++ -- enough room in handle buffer?+ if (size - w > count)+ -- There's enough room in the buffer:+ -- just copy the data in and update bufR.+ then do debugIO ("hPutBuf: copying to buffer, w=" ++ show w)+ copyToRawBuffer old_raw w ptr (fromIntegral count)+ writeIORef haByteBuffer old_buf{ bufR = w + count }+ return count++ -- else, we have to flush+ else do debugIO "hPutBuf: flushing first"+ old_buf' <- Buffered.flushWriteBuffer haDevice old_buf+ -- TODO: we should do a non-blocking flush here+ writeIORef haByteBuffer old_buf'+ -- if we can fit in the buffer, then just loop + if count < size+ then bufWrite h_ ptr count can_block+ else if can_block+ then do writeChunk h_ (castPtr ptr) count+ return count+ else writeChunkNonBlocking h_ (castPtr ptr) count++writeChunk :: Handle__ -> Ptr Word8 -> Int -> IO ()+writeChunk h_@Handle__{..} ptr bytes+ | Just fd <- cast haDevice = RawIO.write (fd::FD) ptr bytes+ | otherwise = error "Todo: hPutBuf"++writeChunkNonBlocking :: Handle__ -> Ptr Word8 -> Int -> IO Int+writeChunkNonBlocking h_@Handle__{..} ptr bytes + | Just fd <- cast haDevice = RawIO.writeNonBlocking (fd::FD) ptr bytes+ | otherwise = error "Todo: hPutBuf"++-- ---------------------------------------------------------------------------+-- hGetBuf++-- | 'hGetBuf' @hdl buf count@ reads data from the handle @hdl@+-- into the buffer @buf@ until either EOF is reached or+-- @count@ 8-bit bytes have been read.+-- It returns the number of bytes actually read. This may be zero if+-- EOF was reached before any data was read (or if @count@ is zero).+--+-- 'hGetBuf' ignores whatever 'TextEncoding' the 'Handle' is currently+-- using, and reads bytes directly from the underlying IO device.+--+-- 'hGetBuf' never raises an EOF exception, instead it returns a value+-- smaller than @count@.+--+-- If the handle is a pipe or socket, and the writing end+-- is closed, 'hGetBuf' will behave as if EOF was reached.+--+-- 'hGetBuf' ignores the prevailing 'TextEncoding' and 'NewlineMode'+-- on the 'Handle', and reads bytes directly.++hGetBuf :: Handle -> Ptr a -> Int -> IO Int+hGetBuf h ptr count+ | count == 0 = return 0+ | count < 0 = illegalBufferSize h "hGetBuf" count+ | otherwise = + wantReadableHandle_ "hGetBuf" h $ \ h_ -> do+ flushCharReadBuffer h_+ bufRead h_ (castPtr ptr) 0 count++-- small reads go through the buffer, large reads are satisfied by+-- taking data first from the buffer and then direct from the file+-- descriptor.+bufRead :: Handle__ -> Ptr Word8 -> Int -> Int -> IO Int+bufRead h_@Handle__{..} ptr so_far count =+ seq so_far $ seq count $ do -- strictness hack+ buf@Buffer{ bufRaw=raw, bufR=w, bufL=r, bufSize=sz } <- readIORef haByteBuffer+ if isEmptyBuffer buf+ then if count > sz -- small read?+ then do rest <- readChunk h_ ptr count+ return (so_far + rest)+ else do (r,buf') <- Buffered.fillReadBuffer haDevice buf+ if r == 0 + then return so_far+ else do writeIORef haByteBuffer buf'+ bufRead h_ ptr so_far count+ else do + let avail = w - r+ if (count == avail)+ then do + copyFromRawBuffer ptr raw r count+ writeIORef haByteBuffer buf{ bufR=0, bufL=0 }+ return (so_far + count)+ else do+ if (count < avail)+ then do + copyFromRawBuffer ptr raw r count+ writeIORef haByteBuffer buf{ bufL = r + count }+ return (so_far + count)+ else do+ + copyFromRawBuffer ptr raw (fromIntegral r) (fromIntegral avail)+ writeIORef haByteBuffer buf{ bufR=0, bufL=0 }+ let remaining = count - avail+ so_far' = so_far + avail+ ptr' = ptr `plusPtr` avail++ if remaining < sz+ then bufRead h_ ptr' so_far' remaining+ else do ++ rest <- readChunk h_ ptr' remaining+ return (so_far' + rest)++readChunk :: Handle__ -> Ptr a -> Int -> IO Int+readChunk h_@Handle__{..} ptr bytes+ | Just fd <- cast haDevice = loop fd 0 bytes+ | otherwise = error "ToDo: hGetBuf"+ where+ loop :: FD -> Int -> Int -> IO Int+ loop fd off bytes | bytes <= 0 = return off+ loop fd off bytes = do+ r <- RawIO.read (fd::FD) (ptr `plusPtr` off) (fromIntegral bytes)+ if r == 0+ then return off+ else loop fd (off + r) (bytes - r)++-- | 'hGetBufNonBlocking' @hdl buf count@ reads data from the handle @hdl@+-- into the buffer @buf@ until either EOF is reached, or+-- @count@ 8-bit bytes have been read, or there is no more data available+-- to read immediately.+--+-- 'hGetBufNonBlocking' is identical to 'hGetBuf', except that it will+-- never block waiting for data to become available, instead it returns+-- only whatever data is available. To wait for data to arrive before+-- calling 'hGetBufNonBlocking', use 'hWaitForInput'.+--+-- 'hGetBufNonBlocking' ignores whatever 'TextEncoding' the 'Handle'+-- is currently using, and reads bytes directly from the underlying IO+-- device.+--+-- If the handle is a pipe or socket, and the writing end+-- is closed, 'hGetBufNonBlocking' will behave as if EOF was reached.+--+-- 'hGetBufNonBlocking' ignores the prevailing 'TextEncoding' and+-- 'NewlineMode' on the 'Handle', and reads bytes directly.++hGetBufNonBlocking :: Handle -> Ptr a -> Int -> IO Int+hGetBufNonBlocking h ptr count+ | count == 0 = return 0+ | count < 0 = illegalBufferSize h "hGetBufNonBlocking" count+ | otherwise = + wantReadableHandle_ "hGetBufNonBlocking" h $ \ h_ -> do+ flushCharReadBuffer h_+ bufReadNonBlocking h_ (castPtr ptr) 0 count++bufReadNonBlocking :: Handle__ -> Ptr Word8 -> Int -> Int -> IO Int+bufReadNonBlocking h_@Handle__{..} ptr so_far count = + seq so_far $ seq count $ do -- strictness hack+ buf@Buffer{ bufRaw=raw, bufR=w, bufL=r, bufSize=sz } <- readIORef haByteBuffer+ if isEmptyBuffer buf+ then if count > sz -- large read?+ then do rest <- readChunkNonBlocking h_ ptr count+ return (so_far + rest)+ else do (r,buf') <- Buffered.fillReadBuffer0 haDevice buf+ case r of+ Nothing -> return so_far+ Just 0 -> return so_far+ Just r -> do+ writeIORef haByteBuffer buf'+ bufReadNonBlocking h_ ptr so_far (min count r)+ -- NOTE: new count is min count w'+ -- so we will just copy the contents of the+ -- buffer in the recursive call, and not+ -- loop again.+ else do+ let avail = w - r+ if (count == avail)+ then do + copyFromRawBuffer ptr raw r count+ writeIORef haByteBuffer buf{ bufR=0, bufL=0 }+ return (so_far + count)+ else do+ if (count < avail)+ then do + copyFromRawBuffer ptr raw r count+ writeIORef haByteBuffer buf{ bufL = r + count }+ return (so_far + count)+ else do++ copyFromRawBuffer ptr raw (fromIntegral r) (fromIntegral avail)+ writeIORef haByteBuffer buf{ bufR=0, bufL=0 }+ let remaining = count - avail+ so_far' = so_far + avail+ ptr' = ptr `plusPtr` avail++ -- we haven't attempted to read anything yet if we get to here.+ if remaining < sz+ then bufReadNonBlocking h_ ptr' so_far' remaining+ else do ++ rest <- readChunkNonBlocking h_ ptr' remaining+ return (so_far' + rest)+++readChunkNonBlocking :: Handle__ -> Ptr Word8 -> Int -> IO Int+readChunkNonBlocking h_@Handle__{..} ptr bytes+ | Just fd <- cast haDevice = do+ m <- RawIO.readNonBlocking (fd::FD) ptr bytes+ case m of+ Nothing -> return 0+ Just n -> return n+ | otherwise = error "ToDo: hGetBuf"++-- ---------------------------------------------------------------------------+-- memcpy wrappers++copyToRawBuffer :: RawBuffer e -> Int -> Ptr e -> Int -> IO ()+copyToRawBuffer raw off ptr bytes =+ withRawBuffer raw $ \praw ->+ do _ <- memcpy (praw `plusPtr` off) ptr (fromIntegral bytes)+ return ()++copyFromRawBuffer :: Ptr e -> RawBuffer e -> Int -> Int -> IO ()+copyFromRawBuffer ptr raw off bytes =+ withRawBuffer raw $ \praw ->+ do _ <- memcpy ptr (praw `plusPtr` off) (fromIntegral bytes)+ return ()++foreign import ccall unsafe "memcpy"+ memcpy :: Ptr a -> Ptr a -> CSize -> IO (Ptr ())++-----------------------------------------------------------------------------+-- Internal Utils++illegalBufferSize :: Handle -> String -> Int -> IO a+illegalBufferSize handle fn sz =+ ioException (IOError (Just handle)+ InvalidArgument fn+ ("illegal buffer size " ++ showsPrec 9 sz [])+ Nothing Nothing)
+ GHC/IO/Handle/Types.hs view
@@ -0,0 +1,402 @@+{-# OPTIONS_GHC -XNoImplicitPrelude -funbox-strict-fields #-}+{-# OPTIONS_HADDOCK hide #-}+-----------------------------------------------------------------------------+-- |+-- Module : GHC.IO.Handle.Types+-- Copyright : (c) The University of Glasgow, 1994-2009+-- License : see libraries/base/LICENSE+-- +-- Maintainer : libraries@haskell.org+-- Stability : internal+-- Portability : non-portable+--+-- Basic types for the implementation of IO Handles.+--+-----------------------------------------------------------------------------++module GHC.IO.Handle.Types (+ Handle(..), Handle__(..), showHandle,+ checkHandleInvariants,+ BufferList(..),+ HandleType(..),+ isReadableHandleType, isWritableHandleType, isReadWriteHandleType,+ BufferMode(..),+ BufferCodec(..),+ NewlineMode(..), Newline(..), nativeNewline,+ universalNewlineMode, noNewlineTranslation, nativeNewlineMode+ ) where++#undef DEBUG++import GHC.Base+import GHC.MVar+import GHC.IO+import GHC.IO.Buffer+import GHC.IO.BufferedIO+import GHC.IO.Encoding.Types+import GHC.IORef+import Data.Maybe+import GHC.Show+import GHC.Read+import GHC.Word+import GHC.IO.Device+import Data.Typeable++-- ---------------------------------------------------------------------------+-- Handle type++-- A Handle is represented by (a reference to) a record +-- containing the state of the I/O port/device. We record+-- the following pieces of info:++-- * type (read,write,closed etc.)+-- * the underlying file descriptor+-- * buffering mode +-- * buffer, and spare buffers+-- * user-friendly name (usually the+-- FilePath used when IO.openFile was called)++-- Note: when a Handle is garbage collected, we want to flush its buffer+-- and close the OS file handle, so as to free up a (precious) resource.++-- | Haskell defines operations to read and write characters from and to files,+-- represented by values of type @Handle@. Each value of this type is a+-- /handle/: a record used by the Haskell run-time system to /manage/ I\/O+-- with file system objects. A handle has at least the following properties:+-- +-- * whether it manages input or output or both;+--+-- * whether it is /open/, /closed/ or /semi-closed/;+--+-- * whether the object is seekable;+--+-- * whether buffering is disabled, or enabled on a line or block basis;+--+-- * a buffer (whose length may be zero).+--+-- Most handles will also have a current I\/O position indicating where the next+-- input or output operation will occur. A handle is /readable/ if it+-- manages only input or both input and output; likewise, it is /writable/ if+-- it manages only output or both input and output. A handle is /open/ when+-- first allocated.+-- Once it is closed it can no longer be used for either input or output,+-- though an implementation cannot re-use its storage while references+-- remain to it. Handles are in the 'Show' and 'Eq' classes. The string+-- produced by showing a handle is system dependent; it should include+-- enough information to identify the handle for debugging. A handle is+-- equal according to '==' only to itself; no attempt+-- is made to compare the internal state of different handles for equality.+--+-- GHC note: a 'Handle' will be automatically closed when the garbage+-- collector detects that it has become unreferenced by the program.+-- However, relying on this behaviour is not generally recommended:+-- the garbage collector is unpredictable. If possible, use explicit+-- an explicit 'hClose' to close 'Handle's when they are no longer+-- required. GHC does not currently attempt to free up file+-- descriptors when they have run out, it is your responsibility to+-- ensure that this doesn't happen.++data Handle + = FileHandle -- A normal handle to a file+ FilePath -- the file (used for error messages+ -- only)+ !(MVar Handle__)++ | DuplexHandle -- A handle to a read/write stream+ FilePath -- file for a FIFO, otherwise some+ -- descriptive string (used for error+ -- messages only)+ !(MVar Handle__) -- The read side+ !(MVar Handle__) -- The write side++ deriving Typeable++-- NOTES:+-- * A 'FileHandle' is seekable. A 'DuplexHandle' may or may not be+-- seekable.++instance Eq Handle where+ (FileHandle _ h1) == (FileHandle _ h2) = h1 == h2+ (DuplexHandle _ h1 _) == (DuplexHandle _ h2 _) = h1 == h2+ _ == _ = False ++data Handle__+ = forall dev enc_state dec_state . (IODevice dev, BufferedIO dev, Typeable dev) =>+ Handle__ {+ haDevice :: !dev,+ haType :: HandleType, -- type (read/write/append etc.)+ haByteBuffer :: !(IORef (Buffer Word8)),+ haBufferMode :: BufferMode,+ haLastDecode :: !(IORef (dec_state, Buffer Word8)),+ haCharBuffer :: !(IORef (Buffer CharBufElem)), -- the current buffer+ haBuffers :: !(IORef (BufferList CharBufElem)), -- spare buffers+ haEncoder :: Maybe (TextEncoder enc_state),+ haDecoder :: Maybe (TextDecoder dec_state),+ haCodec :: Maybe TextEncoding,+ haInputNL :: Newline,+ haOutputNL :: Newline,+ haOtherSide :: Maybe (MVar Handle__) -- ptr to the write side of a + -- duplex handle.+ }+ deriving Typeable++-- we keep a few spare buffers around in a handle to avoid allocating+-- a new one for each hPutStr. These buffers are *guaranteed* to be the+-- same size as the main buffer.+data BufferList e+ = BufferListNil + | BufferListCons (RawBuffer e) (BufferList e)++-- Internally, we classify handles as being one+-- of the following:++data HandleType+ = ClosedHandle+ | SemiClosedHandle+ | ReadHandle+ | WriteHandle+ | AppendHandle+ | ReadWriteHandle++isReadableHandleType :: HandleType -> Bool+isReadableHandleType ReadHandle = True+isReadableHandleType ReadWriteHandle = True+isReadableHandleType _ = False++isWritableHandleType :: HandleType -> Bool+isWritableHandleType AppendHandle = True+isWritableHandleType WriteHandle = True+isWritableHandleType ReadWriteHandle = True+isWritableHandleType _ = False++isReadWriteHandleType :: HandleType -> Bool+isReadWriteHandleType ReadWriteHandle{} = True+isReadWriteHandleType _ = False++-- INVARIANTS on Handles:+--+-- * A handle *always* has a buffer, even if it is only 1 character long+-- (an unbuffered handle needs a 1 character buffer in order to support+-- hLookAhead and hIsEOF).+-- * In a read Handle, the byte buffer is always empty (we decode when reading)+-- * In a wriite Handle, the Char buffer is always empty (we encode when writing)+--+checkHandleInvariants :: Handle__ -> IO ()+#ifdef DEBUG+checkHandleInvariants h_ = do+ bbuf <- readIORef (haByteBuffer h_)+ checkBuffer bbuf+ cbuf <- readIORef (haCharBuffer h_)+ checkBuffer cbuf+#else+checkHandleInvariants _ = return ()+#endif++-- ---------------------------------------------------------------------------+-- Buffering modes++-- | Three kinds of buffering are supported: line-buffering, +-- block-buffering or no-buffering. These modes have the following+-- effects. For output, items are written out, or /flushed/,+-- from the internal buffer according to the buffer mode:+--+-- * /line-buffering/: the entire output buffer is flushed+-- whenever a newline is output, the buffer overflows, +-- a 'System.IO.hFlush' is issued, or the handle is closed.+--+-- * /block-buffering/: the entire buffer is written out whenever it+-- overflows, a 'System.IO.hFlush' is issued, or the handle is closed.+--+-- * /no-buffering/: output is written immediately, and never stored+-- in the buffer.+--+-- An implementation is free to flush the buffer more frequently,+-- but not less frequently, than specified above.+-- The output buffer is emptied as soon as it has been written out.+--+-- Similarly, input occurs according to the buffer mode for the handle:+--+-- * /line-buffering/: when the buffer for the handle is not empty,+-- the next item is obtained from the buffer; otherwise, when the+-- buffer is empty, characters up to and including the next newline+-- character are read into the buffer. No characters are available+-- until the newline character is available or the buffer is full.+--+-- * /block-buffering/: when the buffer for the handle becomes empty,+-- the next block of data is read into the buffer.+--+-- * /no-buffering/: the next input item is read and returned.+-- The 'System.IO.hLookAhead' operation implies that even a no-buffered+-- handle may require a one-character buffer.+--+-- The default buffering mode when a handle is opened is+-- implementation-dependent and may depend on the file system object+-- which is attached to that handle.+-- For most implementations, physical files will normally be block-buffered +-- and terminals will normally be line-buffered.++data BufferMode + = NoBuffering -- ^ buffering is disabled if possible.+ | LineBuffering+ -- ^ line-buffering should be enabled if possible.+ | BlockBuffering (Maybe Int)+ -- ^ block-buffering should be enabled if possible.+ -- The size of the buffer is @n@ items if the argument+ -- is 'Just' @n@ and is otherwise implementation-dependent.+ deriving (Eq, Ord, Read, Show)++{-+[note Buffering Implementation]++Each Handle has two buffers: a byte buffer (haByteBuffer) and a Char+buffer (haCharBuffer). ++[note Buffered Reading]++For read Handles, bytes are read into the byte buffer, and immediately+decoded into the Char buffer (see+GHC.IO.Handle.Internals.readTextDevice). The only way there might be+some data left in the byte buffer is if there is a partial multi-byte+character sequence that cannot be decoded into a full character.++Note that the buffering mode (haBufferMode) makes no difference when+reading data into a Handle. When reading, we can always just read all+the data there is available without blocking, decode it into the Char+buffer, and then provide it immediately to the caller.++[note Buffered Writing]++Characters are written into the Char buffer by e.g. hPutStr. When the+buffer is full, we call writeTextDevice, which encodes the Char buffer+into the byte buffer, and then immediately writes it all out to the+underlying device. The Char buffer will always be empty afterward.+This might require multiple decoding/writing cycles.++[note Buffer Sizing]++Since the buffer mode makes no difference when reading, we can just+use the default buffer size for both the byte and the Char buffer.+Ineed, we must have room for at least one Char in the Char buffer,+because we have to implement hLookAhead, which requires caching a Char+in the Handle. Furthermore, when doing newline translation, we need+room for at least two Chars in the read buffer, so we can spot the+\r\n sequence.++For writing, however, when the buffer mode is NoBuffering, we use a+1-element Char buffer to force flushing of the buffer after each Char+is read.++[note Buffer Flushing]++** Flushing the Char buffer++We must be able to flush the Char buffer, in order to implement+hSetEncoding, and things like hGetBuf which want to read raw bytes.++Flushing the Char buffer on a write Handle is easy: just call+writeTextDevice to encode and write the date.++Flushing the Char buffer on a read Handle involves rewinding the byte+buffer to the point representing the next Char in the Char buffer.+This is done by++ - remembering the state of the byte buffer *before* the last decode++ - re-decoding the bytes that represent the chars already read from the+ Char buffer. This gives us the point in the byte buffer that+ represents the *next* Char to be read.++In order for this to work, after readTextHandle we must NOT MODIFY THE+CONTENTS OF THE BYTE OR CHAR BUFFERS, except to remove characters from+the Char buffer.++** Flushing the byte buffer++The byte buffer can be flushed if the Char buffer has already been+flushed (see above). For a read Handle, flushing the byte buffer+means seeking the device back by the number of bytes in the buffer,+and hence it is only possible on a seekable Handle.++-}++-- ---------------------------------------------------------------------------+-- Newline translation++-- | The representation of a newline in the external file or stream.+data Newline = LF -- ^ '\n'+ | CRLF -- ^ '\r\n'+ deriving Eq++-- | Specifies the translation, if any, of newline characters between+-- internal Strings and the external file or stream. Haskell Strings+-- are assumed to represent newlines with the '\n' character; the+-- newline mode specifies how to translate '\n' on output, and what to+-- translate into '\n' on input.+data NewlineMode + = NewlineMode { inputNL :: Newline,+ -- ^ the representation of newlines on input+ outputNL :: Newline+ -- ^ the representation of newlines on output+ }+ deriving Eq++-- | The native newline representation for the current platform: 'LF'+-- on Unix systems, 'CRLF' on Windows.+nativeNewline :: Newline+#ifdef mingw32_HOST_OS+nativeNewline = CRLF+#else+nativeNewline = LF+#endif++-- | Map '\r\n' into '\n' on input, and '\n' to the native newline+-- represetnation on output. This mode can be used on any platform, and+-- works with text files using any newline convention. The downside is+-- that @readFile >>= writeFile@ might yield a different file.+-- +-- > universalNewlineMode = NewlineMode { inputNL = CRLF, +-- > outputNL = nativeNewline }+--+universalNewlineMode :: NewlineMode+universalNewlineMode = NewlineMode { inputNL = CRLF, + outputNL = nativeNewline }++-- | Use the native newline representation on both input and output+-- +-- > nativeNewlineMode = NewlineMode { inputNL = nativeNewline+-- > outputNL = nativeNewline }+--+nativeNewlineMode :: NewlineMode+nativeNewlineMode = NewlineMode { inputNL = nativeNewline, + outputNL = nativeNewline }++-- | Do no newline translation at all.+-- +-- > noNewlineTranslation = NewlineMode { inputNL = LF, outputNL = LF }+--+noNewlineTranslation :: NewlineMode+noNewlineTranslation = NewlineMode { inputNL = LF, outputNL = LF }++-- ---------------------------------------------------------------------------+-- Show instance for Handles++-- handle types are 'show'n when printing error msgs, so+-- we provide a more user-friendly Show instance for it+-- than the derived one.++instance Show HandleType where+ showsPrec _ t =+ case t of+ ClosedHandle -> showString "closed"+ SemiClosedHandle -> showString "semi-closed"+ ReadHandle -> showString "readable"+ WriteHandle -> showString "writable"+ AppendHandle -> showString "writable (append)"+ ReadWriteHandle -> showString "read-writable"++instance Show Handle where + showsPrec _ (FileHandle file _) = showHandle file+ showsPrec _ (DuplexHandle file _ _) = showHandle file++showHandle :: FilePath -> String -> String+showHandle file = showString "{handle: " . showString file . showString "}"
+ GHC/IO/IOMode.hs view
@@ -0,0 +1,26 @@+{-# OPTIONS_GHC -XNoImplicitPrelude #-}+{-# OPTIONS_HADDOCK hide #-}+-----------------------------------------------------------------------------+-- |+-- Module : GHC.IO.IOMode+-- Copyright : (c) The University of Glasgow, 1994-2008+-- License : see libraries/base/LICENSE+-- +-- Maintainer : libraries@haskell.org+-- Stability : internal+-- Portability : non-portable+--+-- The IOMode type+--+-----------------------------------------------------------------------------++module GHC.IO.IOMode (IOMode(..)) where++import GHC.Base+import GHC.Show+import GHC.Read+import GHC.Arr+import GHC.Enum++data IOMode = ReadMode | WriteMode | AppendMode | ReadWriteMode+ deriving (Eq, Ord, Ix, Enum, Read, Show)
+ GHC/IOArray.hs view
@@ -0,0 +1,69 @@+{-# OPTIONS_GHC -XNoImplicitPrelude -funbox-strict-fields #-}+{-# OPTIONS_HADDOCK hide #-}+-----------------------------------------------------------------------------+-- |+-- Module : GHC.IOArray+-- Copyright : (c) The University of Glasgow 2008+-- License : see libraries/base/LICENSE+-- +-- Maintainer : cvs-ghc@haskell.org+-- Stability : internal+-- Portability : non-portable (GHC Extensions)+--+-- The IOArray type+--+-----------------------------------------------------------------------------++module GHC.IOArray (+ IOArray(..),+ newIOArray, unsafeReadIOArray, unsafeWriteIOArray,+ readIOArray, writeIOArray,+ boundsIOArray+ ) where++import GHC.Base+import GHC.IO+import GHC.Arr++-- ---------------------------------------------------------------------------+-- | An 'IOArray' is a mutable, boxed, non-strict array in the 'IO' monad. +-- The type arguments are as follows:+--+-- * @i@: the index type of the array (should be an instance of 'Ix')+--+-- * @e@: the element type of the array.+--+-- ++newtype IOArray i e = IOArray (STArray RealWorld i e)++-- explicit instance because Haddock can't figure out a derived one+instance Eq (IOArray i e) where+ IOArray x == IOArray y = x == y++-- |Build a new 'IOArray'+newIOArray :: Ix i => (i,i) -> e -> IO (IOArray i e)+{-# INLINE newIOArray #-}+newIOArray lu initial = stToIO $ do {marr <- newSTArray lu initial; return (IOArray marr)}++-- | Read a value from an 'IOArray'+unsafeReadIOArray :: Ix i => IOArray i e -> Int -> IO e+{-# INLINE unsafeReadIOArray #-}+unsafeReadIOArray (IOArray marr) i = stToIO (unsafeReadSTArray marr i)++-- | Write a new value into an 'IOArray'+unsafeWriteIOArray :: Ix i => IOArray i e -> Int -> e -> IO ()+{-# INLINE unsafeWriteIOArray #-}+unsafeWriteIOArray (IOArray marr) i e = stToIO (unsafeWriteSTArray marr i e)++-- | Read a value from an 'IOArray'+readIOArray :: Ix i => IOArray i e -> i -> IO e+readIOArray (IOArray marr) i = stToIO (readSTArray marr i)++-- | Write a new value into an 'IOArray'+writeIOArray :: Ix i => IOArray i e -> i -> e -> IO ()+writeIOArray (IOArray marr) i e = stToIO (writeSTArray marr i e)++{-# INLINE boundsIOArray #-}+boundsIOArray :: IOArray i e -> (i,i) +boundsIOArray (IOArray marr) = boundsSTArray marr
+ GHC/IOBase.hs view
@@ -0,0 +1,91 @@+{-# OPTIONS_HADDOCK hide #-}+-----------------------------------------------------------------------------+-- |+-- Module : GHC.IOBase+-- Copyright : (c) The University of Glasgow 1994-2009+-- License : see libraries/base/LICENSE+-- +-- Maintainer : cvs-ghc@haskell.org+-- Stability : internal+-- Portability : non-portable (GHC Extensions)+--+-- Backwards-compatibility interface+--+-----------------------------------------------------------------------------+++module GHC.IOBase {-# DEPRECATED "use GHC.IO instead" #-} (+ IO(..), unIO, failIO, liftIO, bindIO, thenIO, returnIO, + unsafePerformIO, unsafeInterleaveIO,+ unsafeDupablePerformIO, unsafeDupableInterleaveIO,+ noDuplicate,++ -- To and from from ST+ stToIO, ioToST, unsafeIOToST, unsafeSTToIO,++ -- References+ IORef(..), newIORef, readIORef, writeIORef, + IOArray(..), newIOArray, readIOArray, writeIOArray, unsafeReadIOArray, unsafeWriteIOArray,+ MVar(..),++ -- Handles, file descriptors,+ FilePath, + Handle(..), Handle__(..), HandleType(..), IOMode(..), FD, + isReadableHandleType, isWritableHandleType, isReadWriteHandleType, showHandle,++ -- Buffers+ -- Buffer(..), RawBuffer, BufferState(..), + BufferList(..), BufferMode(..),+ --bufferIsWritable, bufferEmpty, bufferFull, ++ -- Exceptions+ Exception(..), ArithException(..), AsyncException(..), ArrayException(..),+ stackOverflow, heapOverflow, ioException, + IOError, IOException(..), IOErrorType(..), ioError, userError,+ ExitCode(..),+ throwIO, block, unblock, blocked, catchAny, catchException,+ evaluate,+ ErrorCall(..), AssertionFailed(..), assertError, untangle,+ BlockedOnDeadMVar(..), BlockedIndefinitely(..), Deadlock(..),+ blockedOnDeadMVar, blockedIndefinitely+ ) where++import GHC.Base+import GHC.Exception+import GHC.IO+import GHC.IO.Handle.Types+import GHC.IO.IOMode+import GHC.IO.Exception+import GHC.IOArray+import GHC.IORef+import GHC.MVar+import Foreign.C.Types+import GHC.Show+import Data.Typeable++type FD = CInt++-- Backwards compat: this was renamed to BlockedIndefinitelyOnMVar+data BlockedOnDeadMVar = BlockedOnDeadMVar+ deriving Typeable++instance Exception BlockedOnDeadMVar++instance Show BlockedOnDeadMVar where+ showsPrec _ BlockedOnDeadMVar = showString "thread blocked indefinitely"++blockedOnDeadMVar :: SomeException -- for the RTS+blockedOnDeadMVar = toException BlockedOnDeadMVar+++-- Backwards compat: this was renamed to BlockedIndefinitelyOnSTM+data BlockedIndefinitely = BlockedIndefinitely+ deriving Typeable++instance Exception BlockedIndefinitely++instance Show BlockedIndefinitely where+ showsPrec _ BlockedIndefinitely = showString "thread blocked indefinitely"++blockedIndefinitely :: SomeException -- for the RTS+blockedIndefinitely = toException BlockedIndefinitely
− GHC/IOBase.lhs
@@ -1,1040 +0,0 @@-\begin{code}-{-# OPTIONS_GHC -XNoImplicitPrelude -funbox-strict-fields #-}-{-# OPTIONS_HADDOCK hide #-}--------------------------------------------------------------------------------- |--- Module : GHC.IOBase--- Copyright : (c) The University of Glasgow 1994-2002--- License : see libraries/base/LICENSE--- --- Maintainer : cvs-ghc@haskell.org--- Stability : internal--- Portability : non-portable (GHC Extensions)------ Definitions for the 'IO' monad and its friends.------------------------------------------------------------------------------------- #hide-module GHC.IOBase(- IO(..), unIO, failIO, liftIO, bindIO, thenIO, returnIO, - unsafePerformIO, unsafeInterleaveIO,- unsafeDupablePerformIO, unsafeDupableInterleaveIO,- noDuplicate,-- -- To and from from ST- stToIO, ioToST, unsafeIOToST, unsafeSTToIO,-- -- References- IORef(..), newIORef, readIORef, writeIORef, - IOArray(..), newIOArray, readIOArray, writeIOArray, unsafeReadIOArray, - unsafeWriteIOArray, boundsIOArray,- MVar(..),-- -- Handles, file descriptors,- FilePath, - Handle(..), Handle__(..), HandleType(..), IOMode(..), FD, - isReadableHandleType, isWritableHandleType, isReadWriteHandleType, showHandle,-- -- Buffers- Buffer(..), RawBuffer, BufferState(..), BufferList(..), BufferMode(..),- bufferIsWritable, bufferEmpty, bufferFull, -- -- Exceptions- Exception(..), ArithException(..), AsyncException(..), ArrayException(..),- stackOverflow, heapOverflow, ioException, - IOError, IOException(..), IOErrorType(..), ioError, userError,- ExitCode(..),- throwIO, block, unblock, blocked, catchAny, catchException,- evaluate,- ErrorCall(..), AssertionFailed(..), assertError, untangle,- BlockedOnDeadMVar(..), BlockedIndefinitely(..), Deadlock(..),- blockedOnDeadMVar, blockedIndefinitely- ) where--import GHC.ST-import GHC.Arr -- to derive Ix class-import GHC.Enum -- to derive Enum class-import GHC.STRef-import GHC.Base--- import GHC.Num -- To get fromInteger etc, needed because of -XNoImplicitPrelude-import Data.Maybe ( Maybe(..) )-import GHC.Show-import GHC.List-import GHC.Read-import Foreign.C.Types (CInt)-import GHC.Exception--#ifndef __HADDOCK__-import {-# SOURCE #-} Data.Typeable ( Typeable )-#endif---- ------------------------------------------------------------------------------ The IO Monad--{--The IO Monad is just an instance of the ST monad, where the state is-the real world. We use the exception mechanism (in GHC.Exception) to-implement IO exceptions.--NOTE: The IO representation is deeply wired in to various parts of the-system. The following list may or may not be exhaustive:--Compiler - types of various primitives in PrimOp.lhs--RTS - forceIO (StgMiscClosures.hc)- - catchzh_fast, (un)?blockAsyncExceptionszh_fast, raisezh_fast - (Exceptions.hc)- - raiseAsync (Schedule.c)--Prelude - GHC.IOBase.lhs, and several other places including- GHC.Exception.lhs.--Libraries - parts of hslibs/lang.----SDM--}--{-|-A value of type @'IO' a@ is a computation which, when performed,-does some I\/O before returning a value of type @a@. --There is really only one way to \"perform\" an I\/O action: bind it to-@Main.main@ in your program. When your program is run, the I\/O will-be performed. It isn't possible to perform I\/O from an arbitrary-function, unless that function is itself in the 'IO' monad and called-at some point, directly or indirectly, from @Main.main@.--'IO' is a monad, so 'IO' actions can be combined using either the do-notation-or the '>>' and '>>=' operations from the 'Monad' class.--}-newtype IO a = IO (State# RealWorld -> (# State# RealWorld, a #))--unIO :: IO a -> (State# RealWorld -> (# State# RealWorld, a #))-unIO (IO a) = a--instance Functor IO where- fmap f x = x >>= (return . f)--instance Monad IO where- {-# INLINE return #-}- {-# INLINE (>>) #-}- {-# INLINE (>>=) #-}- m >> k = m >>= \ _ -> k- return x = returnIO x-- m >>= k = bindIO m k- fail s = failIO s--failIO :: String -> IO a-failIO s = ioError (userError s)--liftIO :: IO a -> State# RealWorld -> STret RealWorld a-liftIO (IO m) = \s -> case m s of (# s', r #) -> STret s' r--bindIO :: IO a -> (a -> IO b) -> IO b-bindIO (IO m) k = IO ( \ s ->- case m s of - (# new_s, a #) -> unIO (k a) new_s- )--thenIO :: IO a -> IO b -> IO b-thenIO (IO m) k = IO ( \ s ->- case m s of - (# new_s, _ #) -> unIO k new_s- )--returnIO :: a -> IO a-returnIO x = IO (\ s -> (# s, x #))---- ------------------------------------------------------------------------------ Coercions between IO and ST---- | A monad transformer embedding strict state transformers in the 'IO'--- monad. The 'RealWorld' parameter indicates that the internal state--- used by the 'ST' computation is a special one supplied by the 'IO'--- monad, and thus distinct from those used by invocations of 'runST'.-stToIO :: ST RealWorld a -> IO a-stToIO (ST m) = IO m--ioToST :: IO a -> ST RealWorld a-ioToST (IO m) = (ST m)---- This relies on IO and ST having the same representation modulo the--- constraint on the type of the state----unsafeIOToST :: IO a -> ST s a-unsafeIOToST (IO io) = ST $ \ s -> (unsafeCoerce# io) s--unsafeSTToIO :: ST s a -> IO a-unsafeSTToIO (ST m) = IO (unsafeCoerce# m)---- ------------------------------------------------------------------------------ Unsafe IO operations--{-|-This is the \"back door\" into the 'IO' monad, allowing-'IO' computation to be performed at any time. For-this to be safe, the 'IO' computation should be-free of side effects and independent of its environment.--If the I\/O computation wrapped in 'unsafePerformIO'-performs side effects, then the relative order in which those side-effects take place (relative to the main I\/O trunk, or other calls to-'unsafePerformIO') is indeterminate. You have to be careful when -writing and compiling modules that use 'unsafePerformIO':-- * Use @{\-\# NOINLINE foo \#-\}@ as a pragma on any function @foo@- that calls 'unsafePerformIO'. If the call is inlined,- the I\/O may be performed more than once.-- * Use the compiler flag @-fno-cse@ to prevent common sub-expression- elimination being performed on the module, which might combine- two side effects that were meant to be separate. A good example- is using multiple global variables (like @test@ in the example below).-- * Make sure that the either you switch off let-floating, or that the - call to 'unsafePerformIO' cannot float outside a lambda. For example, - if you say:- @- f x = unsafePerformIO (newIORef [])- @- you may get only one reference cell shared between all calls to @f@.- Better would be- @- f x = unsafePerformIO (newIORef [x])- @- because now it can't float outside the lambda.--It is less well known that-'unsafePerformIO' is not type safe. For example:--> test :: IORef [a]-> test = unsafePerformIO $ newIORef []-> -> main = do-> writeIORef test [42]-> bang <- readIORef test-> print (bang :: [Char])--This program will core dump. This problem with polymorphic references-is well known in the ML community, and does not arise with normal-monadic use of references. There is no easy way to make it impossible-once you use 'unsafePerformIO'. Indeed, it is-possible to write @coerce :: a -> b@ with the-help of 'unsafePerformIO'. So be careful!--}-unsafePerformIO :: IO a -> a-unsafePerformIO m = unsafeDupablePerformIO (noDuplicate >> m)--{-| -This version of 'unsafePerformIO' is slightly more efficient,-because it omits the check that the IO is only being performed by a-single thread. Hence, when you write 'unsafeDupablePerformIO',-there is a possibility that the IO action may be performed multiple-times (on a multiprocessor), and you should therefore ensure that-it gives the same results each time.--}-{-# NOINLINE unsafeDupablePerformIO #-}-unsafeDupablePerformIO :: IO a -> a-unsafeDupablePerformIO (IO m) = lazy (case m realWorld# of (# _, r #) -> r)---- Why do we NOINLINE unsafeDupablePerformIO? See the comment with--- GHC.ST.runST. Essentially the issue is that the IO computation--- inside unsafePerformIO must be atomic: it must either all run, or--- not at all. If we let the compiler see the application of the IO--- to realWorld#, it might float out part of the IO.---- Why is there a call to 'lazy' in unsafeDupablePerformIO?--- If we don't have it, the demand analyser discovers the following strictness--- for unsafeDupablePerformIO: C(U(AV))--- But then consider--- unsafeDupablePerformIO (\s -> let r = f x in --- case writeIORef v r s of (# s1, _ #) ->--- (# s1, r #)--- The strictness analyser will find that the binding for r is strict,--- (becuase of uPIO's strictness sig), and so it'll evaluate it before --- doing the writeIORef. This actually makes tests/lib/should_run/memo002--- get a deadlock! ------ Solution: don't expose the strictness of unsafeDupablePerformIO,--- by hiding it with 'lazy'--{-|-'unsafeInterleaveIO' allows 'IO' computation to be deferred lazily.-When passed a value of type @IO a@, the 'IO' will only be performed-when the value of the @a@ is demanded. This is used to implement lazy-file reading, see 'System.IO.hGetContents'.--}-{-# INLINE unsafeInterleaveIO #-}-unsafeInterleaveIO :: IO a -> IO a-unsafeInterleaveIO m = unsafeDupableInterleaveIO (noDuplicate >> m)---- We believe that INLINE on unsafeInterleaveIO is safe, because the--- state from this IO thread is passed explicitly to the interleaved--- IO, so it cannot be floated out and shared.--{-# INLINE unsafeDupableInterleaveIO #-}-unsafeDupableInterleaveIO :: IO a -> IO a-unsafeDupableInterleaveIO (IO m)- = IO ( \ s -> let- r = case m s of (# _, res #) -> res- in- (# s, r #))--{-| -Ensures that the suspensions under evaluation by the current thread-are unique; that is, the current thread is not evaluating anything-that is also under evaluation by another thread that has also executed-'noDuplicate'.--This operation is used in the definition of 'unsafePerformIO' to-prevent the IO action from being executed multiple times, which is usually-undesirable.--}-noDuplicate :: IO ()-noDuplicate = IO $ \s -> case noDuplicate# s of s' -> (# s', () #)---- ------------------------------------------------------------------------------ Handle type--data MVar a = MVar (MVar# RealWorld a)-{- ^-An 'MVar' (pronounced \"em-var\") is a synchronising variable, used-for communication between concurrent threads. It can be thought of-as a a box, which may be empty or full.--}---- pull in Eq (Mvar a) too, to avoid GHC.Conc being an orphan-instance module-instance Eq (MVar a) where- (MVar mvar1#) == (MVar mvar2#) = sameMVar# mvar1# mvar2#---- A Handle is represented by (a reference to) a record --- containing the state of the I/O port/device. We record--- the following pieces of info:---- * type (read,write,closed etc.)--- * the underlying file descriptor--- * buffering mode --- * buffer, and spare buffers--- * user-friendly name (usually the--- FilePath used when IO.openFile was called)---- Note: when a Handle is garbage collected, we want to flush its buffer--- and close the OS file handle, so as to free up a (precious) resource.---- | Haskell defines operations to read and write characters from and to files,--- represented by values of type @Handle@. Each value of this type is a--- /handle/: a record used by the Haskell run-time system to /manage/ I\/O--- with file system objects. A handle has at least the following properties:--- --- * whether it manages input or output or both;------ * whether it is /open/, /closed/ or /semi-closed/;------ * whether the object is seekable;------ * whether buffering is disabled, or enabled on a line or block basis;------ * a buffer (whose length may be zero).------ Most handles will also have a current I\/O position indicating where the next--- input or output operation will occur. A handle is /readable/ if it--- manages only input or both input and output; likewise, it is /writable/ if--- it manages only output or both input and output. A handle is /open/ when--- first allocated.--- Once it is closed it can no longer be used for either input or output,--- though an implementation cannot re-use its storage while references--- remain to it. Handles are in the 'Show' and 'Eq' classes. The string--- produced by showing a handle is system dependent; it should include--- enough information to identify the handle for debugging. A handle is--- equal according to '==' only to itself; no attempt--- is made to compare the internal state of different handles for equality.------ GHC note: a 'Handle' will be automatically closed when the garbage--- collector detects that it has become unreferenced by the program.--- However, relying on this behaviour is not generally recommended:--- the garbage collector is unpredictable. If possible, use explicit--- an explicit 'hClose' to close 'Handle's when they are no longer--- required. GHC does not currently attempt to free up file--- descriptors when they have run out, it is your responsibility to--- ensure that this doesn't happen.--data Handle - = FileHandle -- A normal handle to a file- FilePath -- the file (invariant)- !(MVar Handle__)-- | DuplexHandle -- A handle to a read/write stream- FilePath -- file for a FIFO, otherwise some- -- descriptive string.- !(MVar Handle__) -- The read side- !(MVar Handle__) -- The write side---- NOTES:--- * A 'FileHandle' is seekable. A 'DuplexHandle' may or may not be--- seekable.--instance Eq Handle where- (FileHandle _ h1) == (FileHandle _ h2) = h1 == h2- (DuplexHandle _ h1 _) == (DuplexHandle _ h2 _) = h1 == h2- _ == _ = False --type FD = CInt--data Handle__- = Handle__ {- haFD :: !FD, -- file descriptor- haType :: HandleType, -- type (read/write/append etc.)- haIsBin :: Bool, -- binary mode?- haIsStream :: Bool, -- Windows : is this a socket?- -- Unix : is O_NONBLOCK set?- haBufferMode :: BufferMode, -- buffer contains read/write data?- haBuffer :: !(IORef Buffer), -- the current buffer- haBuffers :: !(IORef BufferList), -- spare buffers- haOtherSide :: Maybe (MVar Handle__) -- ptr to the write side of a - -- duplex handle.- }---- ------------------------------------------------------------------------------ Buffers---- The buffer is represented by a mutable variable containing a--- record, where the record contains the raw buffer and the start/end--- points of the filled portion. We use a mutable variable so that--- the common operation of writing (or reading) some data from (to)--- the buffer doesn't need to modify, and hence copy, the handle--- itself, it just updates the buffer. ---- There will be some allocation involved in a simple hPutChar in--- order to create the new Buffer structure (below), but this is--- relatively small, and this only has to be done once per write--- operation.---- The buffer contains its size - we could also get the size by--- calling sizeOfMutableByteArray# on the raw buffer, but that tends--- to be rounded up to the nearest Word.--type RawBuffer = MutableByteArray# RealWorld---- INVARIANTS on a Buffer:------ * A handle *always* has a buffer, even if it is only 1 character long--- (an unbuffered handle needs a 1 character buffer in order to support--- hLookAhead and hIsEOF).--- * r <= w--- * if r == w, then r == 0 && w == 0--- * if state == WriteBuffer, then r == 0--- * a write buffer is never full. If an operation--- fills up the buffer, it will always flush it before --- returning.--- * a read buffer may be full as a result of hLookAhead. In normal--- operation, a read buffer always has at least one character of space.--data Buffer - = Buffer {- bufBuf :: RawBuffer,- bufRPtr :: !Int,- bufWPtr :: !Int,- bufSize :: !Int,- bufState :: BufferState- }--data BufferState = ReadBuffer | WriteBuffer deriving (Eq)---- we keep a few spare buffers around in a handle to avoid allocating--- a new one for each hPutStr. These buffers are *guaranteed* to be the--- same size as the main buffer.-data BufferList - = BufferListNil - | BufferListCons RawBuffer BufferList---bufferIsWritable :: Buffer -> Bool-bufferIsWritable Buffer{ bufState=WriteBuffer } = True-bufferIsWritable _other = False--bufferEmpty :: Buffer -> Bool-bufferEmpty Buffer{ bufRPtr=r, bufWPtr=w } = r == w---- only makes sense for a write buffer-bufferFull :: Buffer -> Bool-bufferFull b@Buffer{ bufWPtr=w } = w >= bufSize b---- Internally, we classify handles as being one--- of the following:--data HandleType- = ClosedHandle- | SemiClosedHandle- | ReadHandle- | WriteHandle- | AppendHandle- | ReadWriteHandle--isReadableHandleType :: HandleType -> Bool-isReadableHandleType ReadHandle = True-isReadableHandleType ReadWriteHandle = True-isReadableHandleType _ = False--isWritableHandleType :: HandleType -> Bool-isWritableHandleType AppendHandle = True-isWritableHandleType WriteHandle = True-isWritableHandleType ReadWriteHandle = True-isWritableHandleType _ = False--isReadWriteHandleType :: HandleType -> Bool-isReadWriteHandleType ReadWriteHandle{} = True-isReadWriteHandleType _ = False---- | File and directory names are values of type 'String', whose precise--- meaning is operating system dependent. Files can be opened, yielding a--- handle which can then be used to operate on the contents of that file.--type FilePath = String---- ------------------------------------------------------------------------------ Buffering modes---- | Three kinds of buffering are supported: line-buffering, --- block-buffering or no-buffering. These modes have the following--- effects. For output, items are written out, or /flushed/,--- from the internal buffer according to the buffer mode:------ * /line-buffering/: the entire output buffer is flushed--- whenever a newline is output, the buffer overflows, --- a 'System.IO.hFlush' is issued, or the handle is closed.------ * /block-buffering/: the entire buffer is written out whenever it--- overflows, a 'System.IO.hFlush' is issued, or the handle is closed.------ * /no-buffering/: output is written immediately, and never stored--- in the buffer.------ An implementation is free to flush the buffer more frequently,--- but not less frequently, than specified above.--- The output buffer is emptied as soon as it has been written out.------ Similarly, input occurs according to the buffer mode for the handle:------ * /line-buffering/: when the buffer for the handle is not empty,--- the next item is obtained from the buffer; otherwise, when the--- buffer is empty, characters up to and including the next newline--- character are read into the buffer. No characters are available--- until the newline character is available or the buffer is full.------ * /block-buffering/: when the buffer for the handle becomes empty,--- the next block of data is read into the buffer.------ * /no-buffering/: the next input item is read and returned.--- The 'System.IO.hLookAhead' operation implies that even a no-buffered--- handle may require a one-character buffer.------ The default buffering mode when a handle is opened is--- implementation-dependent and may depend on the file system object--- which is attached to that handle.--- For most implementations, physical files will normally be block-buffered --- and terminals will normally be line-buffered.--data BufferMode - = NoBuffering -- ^ buffering is disabled if possible.- | LineBuffering- -- ^ line-buffering should be enabled if possible.- | BlockBuffering (Maybe Int)- -- ^ block-buffering should be enabled if possible.- -- The size of the buffer is @n@ items if the argument- -- is 'Just' @n@ and is otherwise implementation-dependent.- deriving (Eq, Ord, Read, Show)---- ------------------------------------------------------------------------------ IORefs---- |A mutable variable in the 'IO' monad-newtype IORef a = IORef (STRef RealWorld a)---- explicit instance because Haddock can't figure out a derived one-instance Eq (IORef a) where- IORef x == IORef y = x == y---- |Build a new 'IORef'-newIORef :: a -> IO (IORef a)-newIORef v = stToIO (newSTRef v) >>= \ var -> return (IORef var)---- |Read the value of an 'IORef'-readIORef :: IORef a -> IO a-readIORef (IORef var) = stToIO (readSTRef var)---- |Write a new value into an 'IORef'-writeIORef :: IORef a -> a -> IO ()-writeIORef (IORef var) v = stToIO (writeSTRef var v)---- ------------------------------------------------------------------------------ | An 'IOArray' is a mutable, boxed, non-strict array in the 'IO' monad. --- The type arguments are as follows:------ * @i@: the index type of the array (should be an instance of 'Ix')------ * @e@: the element type of the array.------ --newtype IOArray i e = IOArray (STArray RealWorld i e)---- explicit instance because Haddock can't figure out a derived one-instance Eq (IOArray i e) where- IOArray x == IOArray y = x == y---- |Build a new 'IOArray'-newIOArray :: Ix i => (i,i) -> e -> IO (IOArray i e)-{-# INLINE newIOArray #-}-newIOArray lu initial = stToIO $ do {marr <- newSTArray lu initial; return (IOArray marr)}---- | Read a value from an 'IOArray'-unsafeReadIOArray :: Ix i => IOArray i e -> Int -> IO e-{-# INLINE unsafeReadIOArray #-}-unsafeReadIOArray (IOArray marr) i = stToIO (unsafeReadSTArray marr i)---- | Write a new value into an 'IOArray'-unsafeWriteIOArray :: Ix i => IOArray i e -> Int -> e -> IO ()-{-# INLINE unsafeWriteIOArray #-}-unsafeWriteIOArray (IOArray marr) i e = stToIO (unsafeWriteSTArray marr i e)---- | Read a value from an 'IOArray'-readIOArray :: Ix i => IOArray i e -> i -> IO e-readIOArray (IOArray marr) i = stToIO (readSTArray marr i)---- | Write a new value into an 'IOArray'-writeIOArray :: Ix i => IOArray i e -> i -> e -> IO ()-writeIOArray (IOArray marr) i e = stToIO (writeSTArray marr i e)--{-# INLINE boundsIOArray #-}-boundsIOArray :: IOArray i e -> (i,i) -boundsIOArray (IOArray marr) = boundsSTArray marr---- ------------------------------------------------------------------------------ Show instance for Handles---- handle types are 'show'n when printing error msgs, so--- we provide a more user-friendly Show instance for it--- than the derived one.--instance Show HandleType where- showsPrec _ t =- case t of- ClosedHandle -> showString "closed"- SemiClosedHandle -> showString "semi-closed"- ReadHandle -> showString "readable"- WriteHandle -> showString "writable"- AppendHandle -> showString "writable (append)"- ReadWriteHandle -> showString "read-writable"--instance Show Handle where - showsPrec _ (FileHandle file _) = showHandle file- showsPrec _ (DuplexHandle file _ _) = showHandle file--showHandle :: FilePath -> String -> String-showHandle file = showString "{handle: " . showString file . showString "}"---- --------------------------------------------------------------------------- Exception datatypes and operations---- |The thread is blocked on an @MVar@, but there are no other references--- to the @MVar@ so it can't ever continue.-data BlockedOnDeadMVar = BlockedOnDeadMVar- deriving Typeable--instance Exception BlockedOnDeadMVar--instance Show BlockedOnDeadMVar where- showsPrec _ BlockedOnDeadMVar = showString "thread blocked indefinitely"--blockedOnDeadMVar :: SomeException -- for the RTS-blockedOnDeadMVar = toException BlockedOnDeadMVar----------- |The thread is awiting to retry an STM transaction, but there are no--- other references to any @TVar@s involved, so it can't ever continue.-data BlockedIndefinitely = BlockedIndefinitely- deriving Typeable--instance Exception BlockedIndefinitely--instance Show BlockedIndefinitely where- showsPrec _ BlockedIndefinitely = showString "thread blocked indefinitely"--blockedIndefinitely :: SomeException -- for the RTS-blockedIndefinitely = toException BlockedIndefinitely----------- |There are no runnable threads, so the program is deadlocked.--- The @Deadlock@ exception is raised in the main thread only.-data Deadlock = Deadlock- deriving Typeable--instance Exception Deadlock--instance Show Deadlock where- showsPrec _ Deadlock = showString "<<deadlock>>"----------- |Exceptions generated by 'assert'. The @String@ gives information--- about the source location of the assertion.-data AssertionFailed = AssertionFailed String- deriving Typeable--instance Exception AssertionFailed--instance Show AssertionFailed where- showsPrec _ (AssertionFailed err) = showString err----------- |Asynchronous exceptions.-data AsyncException- = StackOverflow- -- ^The current thread\'s stack exceeded its limit.- -- Since an exception has been raised, the thread\'s stack- -- will certainly be below its limit again, but the- -- programmer should take remedial action- -- immediately.- | HeapOverflow- -- ^The program\'s heap is reaching its limit, and- -- the program should take action to reduce the amount of- -- live data it has. Notes:- --- -- * It is undefined which thread receives this exception.- --- -- * GHC currently does not throw 'HeapOverflow' exceptions.- | ThreadKilled- -- ^This exception is raised by another thread- -- calling 'Control.Concurrent.killThread', or by the system- -- if it needs to terminate the thread for some- -- reason.- | UserInterrupt- -- ^This exception is raised by default in the main thread of- -- the program when the user requests to terminate the program- -- via the usual mechanism(s) (e.g. Control-C in the console).- deriving (Eq, Ord, Typeable)--instance Exception AsyncException---- | Exceptions generated by array operations-data ArrayException- = IndexOutOfBounds String- -- ^An attempt was made to index an array outside- -- its declared bounds.- | UndefinedElement String- -- ^An attempt was made to evaluate an element of an- -- array that had not been initialized.- deriving (Eq, Ord, Typeable)--instance Exception ArrayException--stackOverflow, heapOverflow :: SomeException -- for the RTS-stackOverflow = toException StackOverflow-heapOverflow = toException HeapOverflow--instance Show AsyncException where- showsPrec _ StackOverflow = showString "stack overflow"- showsPrec _ HeapOverflow = showString "heap overflow"- showsPrec _ ThreadKilled = showString "thread killed"- showsPrec _ UserInterrupt = showString "user interrupt"--instance Show ArrayException where- showsPrec _ (IndexOutOfBounds s)- = showString "array index out of range"- . (if not (null s) then showString ": " . showString s- else id)- showsPrec _ (UndefinedElement s)- = showString "undefined array element"- . (if not (null s) then showString ": " . showString s- else id)---- -------------------------------------------------------------------------------- The ExitCode type---- We need it here because it is used in ExitException in the--- Exception datatype (above).--data ExitCode- = ExitSuccess -- ^ indicates successful termination;- | ExitFailure Int- -- ^ indicates program failure with an exit code.- -- The exact interpretation of the code is- -- operating-system dependent. In particular, some values- -- may be prohibited (e.g. 0 on a POSIX-compliant system).- deriving (Eq, Ord, Read, Show, Typeable)--instance Exception ExitCode--ioException :: IOException -> IO a-ioException err = throwIO err---- | Raise an 'IOError' in the 'IO' monad.-ioError :: IOError -> IO a -ioError = ioException---- ------------------------------------------------------------------------------ IOError type---- | The Haskell 98 type for exceptions in the 'IO' monad.--- Any I\/O operation may raise an 'IOError' instead of returning a result.--- For a more general type of exception, including also those that arise--- in pure code, see 'Control.Exception.Exception'.------ In Haskell 98, this is an opaque type.-type IOError = IOException---- |Exceptions that occur in the @IO@ monad.--- An @IOException@ records a more specific error type, a descriptive--- string and maybe the handle that was used when the error was--- flagged.-data IOException- = IOError {- ioe_handle :: Maybe Handle, -- the handle used by the action flagging - -- the error.- ioe_type :: IOErrorType, -- what it was.- ioe_location :: String, -- location.- ioe_description :: String, -- error type specific information.- ioe_filename :: Maybe FilePath -- filename the error is related to.- }- deriving Typeable--instance Exception IOException--instance Eq IOException where- (IOError h1 e1 loc1 str1 fn1) == (IOError h2 e2 loc2 str2 fn2) = - e1==e2 && str1==str2 && h1==h2 && loc1==loc2 && fn1==fn2---- | An abstract type that contains a value for each variant of 'IOError'.-data IOErrorType- -- Haskell 98:- = AlreadyExists- | NoSuchThing- | ResourceBusy- | ResourceExhausted- | EOF- | IllegalOperation- | PermissionDenied- | UserError- -- GHC only:- | UnsatisfiedConstraints- | SystemError- | ProtocolError- | OtherError- | InvalidArgument- | InappropriateType- | HardwareFault- | UnsupportedOperation- | TimeExpired- | ResourceVanished- | Interrupted--instance Eq IOErrorType where- x == y = getTag x ==# getTag y- -instance Show IOErrorType where- showsPrec _ e =- showString $- case e of- AlreadyExists -> "already exists"- NoSuchThing -> "does not exist"- ResourceBusy -> "resource busy"- ResourceExhausted -> "resource exhausted"- EOF -> "end of file"- IllegalOperation -> "illegal operation"- PermissionDenied -> "permission denied"- UserError -> "user error"- HardwareFault -> "hardware fault"- InappropriateType -> "inappropriate type"- Interrupted -> "interrupted"- InvalidArgument -> "invalid argument"- OtherError -> "failed"- ProtocolError -> "protocol error"- ResourceVanished -> "resource vanished"- SystemError -> "system error"- TimeExpired -> "timeout"- UnsatisfiedConstraints -> "unsatisified constraints" -- ultra-precise!- UnsupportedOperation -> "unsupported operation"---- | Construct an 'IOError' value with a string describing the error.--- The 'fail' method of the 'IO' instance of the 'Monad' class raises a--- 'userError', thus:------ > instance Monad IO where --- > ...--- > fail s = ioError (userError s)----userError :: String -> IOError-userError str = IOError Nothing UserError "" str Nothing---- ------------------------------------------------------------------------------ Showing IOErrors--instance Show IOException where- showsPrec p (IOError hdl iot loc s fn) =- (case fn of- Nothing -> case hdl of- Nothing -> id- Just h -> showsPrec p h . showString ": "- Just name -> showString name . showString ": ") .- (case loc of- "" -> id- _ -> showString loc . showString ": ") .- showsPrec p iot . - (case s of- "" -> id- _ -> showString " (" . showString s . showString ")")---- -------------------------------------------------------------------------------- IOMode type--data IOMode = ReadMode | WriteMode | AppendMode | ReadWriteMode- deriving (Eq, Ord, Ix, Enum, Read, Show)-\end{code}--%*********************************************************-%* *-\subsection{Primitive catch and throwIO}-%* *-%*********************************************************--catchException used to handle the passing around of the state to the-action and the handler. This turned out to be a bad idea - it meant-that we had to wrap both arguments in thunks so they could be entered-as normal (remember IO returns an unboxed pair...).--Now catch# has type-- catch# :: IO a -> (b -> IO a) -> IO a--(well almost; the compiler doesn't know about the IO newtype so we-have to work around that in the definition of catchException below).--\begin{code}-catchException :: Exception e => IO a -> (e -> IO a) -> IO a-catchException (IO io) handler = IO $ catch# io handler'- where handler' e = case fromException e of- Just e' -> unIO (handler e')- Nothing -> raise# e--catchAny :: IO a -> (forall e . Exception e => e -> IO a) -> IO a-catchAny (IO io) handler = IO $ catch# io handler'- where handler' (SomeException e) = unIO (handler e)---- | A variant of 'throw' that can only be used within the 'IO' monad.------ Although 'throwIO' has a type that is an instance of the type of 'throw', the--- two functions are subtly different:------ > throw e `seq` x ===> throw e--- > throwIO e `seq` x ===> x------ The first example will cause the exception @e@ to be raised,--- whereas the second one won\'t. In fact, 'throwIO' will only cause--- an exception to be raised when it is used within the 'IO' monad.--- The 'throwIO' variant should be used in preference to 'throw' to--- raise an exception within the 'IO' monad because it guarantees--- ordering with respect to other 'IO' operations, whereas 'throw'--- does not.-throwIO :: Exception e => e -> IO a-throwIO e = IO (raiseIO# (toException e))-\end{code}---%*********************************************************-%* *-\subsection{Controlling asynchronous exception delivery}-%* *-%*********************************************************--\begin{code}--- | Applying 'block' to a computation will--- execute that computation with asynchronous exceptions--- /blocked/. That is, any thread which--- attempts to raise an exception in the current thread with 'Control.Exception.throwTo' will be--- blocked until asynchronous exceptions are enabled again. There\'s--- no need to worry about re-enabling asynchronous exceptions; that is--- done automatically on exiting the scope of--- 'block'.------ Threads created by 'Control.Concurrent.forkIO' inherit the blocked--- state from the parent; that is, to start a thread in blocked mode,--- use @block $ forkIO ...@. This is particularly useful if you need to--- establish an exception handler in the forked thread before any--- asynchronous exceptions are received.-block :: IO a -> IO a---- | To re-enable asynchronous exceptions inside the scope of--- 'block', 'unblock' can be--- used. It scopes in exactly the same way, so on exit from--- 'unblock' asynchronous exception delivery will--- be disabled again.-unblock :: IO a -> IO a--block (IO io) = IO $ blockAsyncExceptions# io-unblock (IO io) = IO $ unblockAsyncExceptions# io---- | returns True if asynchronous exceptions are blocked in the--- current thread.-blocked :: IO Bool-blocked = IO $ \s -> case asyncExceptionsBlocked# s of- (# s', i #) -> (# s', i /=# 0# #)-\end{code}--\begin{code}--- | Forces its argument to be evaluated to weak head normal form when--- the resultant 'IO' action is executed. It can be used to order--- evaluation with respect to other 'IO' operations; its semantics are--- given by------ > evaluate x `seq` y ==> y--- > evaluate x `catch` f ==> (return $! x) `catch` f--- > evaluate x >>= f ==> (return $! x) >>= f------ /Note:/ the first equation implies that @(evaluate x)@ is /not/ the--- same as @(return $! x)@. A correct definition is------ > evaluate x = (return $! x) >>= return----evaluate :: a -> IO a-evaluate a = IO $ \s -> case a `seq` () of () -> (# s, a #)- -- NB. can't write- -- a `seq` (# s, a #)- -- because we can't have an unboxed tuple as a function argument-\end{code}--\begin{code}-assertError :: Addr# -> Bool -> a -> a-assertError str predicate v- | predicate = v- | otherwise = throw (AssertionFailed (untangle str "Assertion failed"))--{--(untangle coded message) expects "coded" to be of the form- "location|details"-It prints- location message details--}-untangle :: Addr# -> String -> String-untangle coded message- = location- ++ ": "- ++ message- ++ details- ++ "\n"- where- coded_str = unpackCStringUtf8# coded-- (location, details)- = case (span not_bar coded_str) of { (loc, rest) ->- case rest of- ('|':det) -> (loc, ' ' : det)- _ -> (loc, "")- }- not_bar c = c /= '|'-\end{code}-
+ GHC/IORef.hs view
@@ -0,0 +1,49 @@+{-# OPTIONS_GHC -XNoImplicitPrelude -funbox-strict-fields #-}+{-# OPTIONS_HADDOCK hide #-}+-----------------------------------------------------------------------------+-- |+-- Module : GHC.IORef+-- Copyright : (c) The University of Glasgow 2008+-- License : see libraries/base/LICENSE+-- +-- Maintainer : cvs-ghc@haskell.org+-- Stability : internal+-- Portability : non-portable (GHC Extensions)+--+-- The IORef type+--+-----------------------------------------------------------------------------+module GHC.IORef (+ IORef(..),+ newIORef, readIORef, writeIORef, atomicModifyIORef+ ) where++import GHC.Base+import GHC.STRef+import GHC.IO++-- ---------------------------------------------------------------------------+-- IORefs++-- |A mutable variable in the 'IO' monad+newtype IORef a = IORef (STRef RealWorld a)++-- explicit instance because Haddock can't figure out a derived one+instance Eq (IORef a) where+ IORef x == IORef y = x == y++-- |Build a new 'IORef'+newIORef :: a -> IO (IORef a)+newIORef v = stToIO (newSTRef v) >>= \ var -> return (IORef var)++-- |Read the value of an 'IORef'+readIORef :: IORef a -> IO a+readIORef (IORef var) = stToIO (readSTRef var)++-- |Write a new value into an 'IORef'+writeIORef :: IORef a -> a -> IO ()+writeIORef (IORef var) v = stToIO (writeSTRef var v)++atomicModifyIORef :: IORef a -> (a -> (a,b)) -> IO b+atomicModifyIORef (IORef (STRef r#)) f = IO $ \s -> atomicModifyMutVar# r# f s+
GHC/Int.hs view
@@ -37,6 +37,7 @@ import GHC.Real import GHC.Read import GHC.Arr+import GHC.Err import GHC.Word hiding (uncheckedShiftL64#, uncheckedShiftRL64#) import GHC.Show @@ -141,8 +142,8 @@ = I8# (narrow8Int# (word2Int# ((x'# `uncheckedShiftL#` i'#) `or#` (x'# `uncheckedShiftRL#` (8# -# i'#))))) where- x'# = narrow8Word# (int2Word# x#)- i'# = word2Int# (int2Word# i# `and#` int2Word# 7#)+ !x'# = narrow8Word# (int2Word# x#)+ !i'# = word2Int# (int2Word# i# `and#` int2Word# 7#) bitSize _ = 8 isSigned _ = True @@ -257,8 +258,8 @@ = I16# (narrow16Int# (word2Int# ((x'# `uncheckedShiftL#` i'#) `or#` (x'# `uncheckedShiftRL#` (16# -# i'#))))) where- x'# = narrow16Word# (int2Word# x#)- i'# = word2Int# (int2Word# i# `and#` int2Word# 15#)+ !x'# = narrow16Word# (int2Word# x#)+ !i'# = word2Int# (int2Word# i# `and#` int2Word# 15#) bitSize _ = 16 isSigned _ = True @@ -506,8 +507,8 @@ = I32# (narrow32Int# (word2Int# ((x'# `uncheckedShiftL#` i'#) `or#` (x'# `uncheckedShiftRL#` (32# -# i'#))))) where- x'# = narrow32Word# (int2Word# x#)- i'# = word2Int# (int2Word# i# `and#` int2Word# 31#)+ !x'# = narrow32Word# (int2Word# x#)+ !i'# = word2Int# (int2Word# i# `and#` int2Word# 31#) bitSize _ = 32 isSigned _ = True @@ -633,7 +634,7 @@ = if r# `neInt64#` intToInt64# 0# then r# `plusInt64#` y# else intToInt64# 0# | otherwise = r# where- r# = x# `remInt64#` y#+ !r# = x# `remInt64#` y# instance Read Int64 where readsPrec p s = [(fromInteger x, r) | (x, r) <- readsPrec p s]@@ -655,8 +656,8 @@ = I64# (word64ToInt64# ((x'# `uncheckedShiftL64#` i'#) `or64#` (x'# `uncheckedShiftRL64#` (64# -# i'#)))) where- x'# = int64ToWord64# x#- i'# = word2Int# (int2Word# i# `and#` int2Word# 63#)+ !x'# = int64ToWord64# x#+ !i'# = word2Int# (int2Word# i# `and#` int2Word# 63#) bitSize _ = 64 isSigned _ = True @@ -773,8 +774,8 @@ = I64# (word2Int# ((x'# `uncheckedShiftL#` i'#) `or#` (x'# `uncheckedShiftRL#` (64# -# i'#)))) where- x'# = int2Word# x#- i'# = word2Int# (int2Word# i# `and#` int2Word# 63#)+ !x'# = int2Word# x#+ !i'# = word2Int# (int2Word# i# `and#` int2Word# 63#) bitSize _ = 64 isSigned _ = True
GHC/List.lhs view
@@ -89,7 +89,7 @@ #endif -- | Return all the elements of a list except the last one.--- The list must be finite and non-empty.+-- The list must be non-empty. init :: [a] -> [a] #ifdef USE_REPORT_PRELUDE init [x] = []
+ GHC/MVar.hs view
@@ -0,0 +1,143 @@+{-# OPTIONS_GHC -XNoImplicitPrelude -funbox-strict-fields #-}+{-# OPTIONS_HADDOCK hide #-}+-----------------------------------------------------------------------------+-- |+-- Module : GHC.MVar+-- Copyright : (c) The University of Glasgow 2008+-- License : see libraries/base/LICENSE+-- +-- Maintainer : cvs-ghc@haskell.org+-- Stability : internal+-- Portability : non-portable (GHC Extensions)+--+-- The MVar type+--+-----------------------------------------------------------------------------++module GHC.MVar (+ -- * MVars+ MVar(..)+ , newMVar -- :: a -> IO (MVar a)+ , newEmptyMVar -- :: IO (MVar a)+ , takeMVar -- :: MVar a -> IO a+ , putMVar -- :: MVar a -> a -> IO ()+ , tryTakeMVar -- :: MVar a -> IO (Maybe a)+ , tryPutMVar -- :: MVar a -> a -> IO Bool+ , isEmptyMVar -- :: MVar a -> IO Bool+ , addMVarFinalizer -- :: MVar a -> IO () -> IO ()++ ) where++import GHC.Base+import GHC.IO() -- instance Monad IO+import Data.Maybe++data MVar a = MVar (MVar# RealWorld a)+{- ^+An 'MVar' (pronounced \"em-var\") is a synchronising variable, used+for communication between concurrent threads. It can be thought of+as a a box, which may be empty or full.+-}++-- pull in Eq (Mvar a) too, to avoid GHC.Conc being an orphan-instance module+instance Eq (MVar a) where+ (MVar mvar1#) == (MVar mvar2#) = sameMVar# mvar1# mvar2#++{-+M-Vars are rendezvous points for concurrent threads. They begin+empty, and any attempt to read an empty M-Var blocks. When an M-Var+is written, a single blocked thread may be freed. Reading an M-Var+toggles its state from full back to empty. Therefore, any value+written to an M-Var may only be read once. Multiple reads and writes+are allowed, but there must be at least one read between any two+writes.+-}++--Defined in IOBase to avoid cycle: data MVar a = MVar (SynchVar# RealWorld a)++-- |Create an 'MVar' which is initially empty.+newEmptyMVar :: IO (MVar a)+newEmptyMVar = IO $ \ s# ->+ case newMVar# s# of+ (# s2#, svar# #) -> (# s2#, MVar svar# #)++-- |Create an 'MVar' which contains the supplied value.+newMVar :: a -> IO (MVar a)+newMVar value =+ newEmptyMVar >>= \ mvar ->+ putMVar mvar value >>+ return mvar++-- |Return the contents of the 'MVar'. If the 'MVar' is currently+-- empty, 'takeMVar' will wait until it is full. After a 'takeMVar', +-- the 'MVar' is left empty.+-- +-- There are two further important properties of 'takeMVar':+--+-- * 'takeMVar' is single-wakeup. That is, if there are multiple+-- threads blocked in 'takeMVar', and the 'MVar' becomes full,+-- only one thread will be woken up. The runtime guarantees that+-- the woken thread completes its 'takeMVar' operation.+--+-- * When multiple threads are blocked on an 'MVar', they are+-- woken up in FIFO order. This is useful for providing+-- fairness properties of abstractions built using 'MVar's.+--+takeMVar :: MVar a -> IO a+takeMVar (MVar mvar#) = IO $ \ s# -> takeMVar# mvar# s#++-- |Put a value into an 'MVar'. If the 'MVar' is currently full,+-- 'putMVar' will wait until it becomes empty.+--+-- There are two further important properties of 'putMVar':+--+-- * 'putMVar' is single-wakeup. That is, if there are multiple+-- threads blocked in 'putMVar', and the 'MVar' becomes empty,+-- only one thread will be woken up. The runtime guarantees that+-- the woken thread completes its 'putMVar' operation.+--+-- * When multiple threads are blocked on an 'MVar', they are+-- woken up in FIFO order. This is useful for providing+-- fairness properties of abstractions built using 'MVar's.+--+putMVar :: MVar a -> a -> IO ()+putMVar (MVar mvar#) x = IO $ \ s# ->+ case putMVar# mvar# x s# of+ s2# -> (# s2#, () #)++-- |A non-blocking version of 'takeMVar'. The 'tryTakeMVar' function+-- returns immediately, with 'Nothing' if the 'MVar' was empty, or+-- @'Just' a@ if the 'MVar' was full with contents @a@. After 'tryTakeMVar',+-- the 'MVar' is left empty.+tryTakeMVar :: MVar a -> IO (Maybe a)+tryTakeMVar (MVar m) = IO $ \ s ->+ case tryTakeMVar# m s of+ (# s', 0#, _ #) -> (# s', Nothing #) -- MVar is empty+ (# s', _, a #) -> (# s', Just a #) -- MVar is full++-- |A non-blocking version of 'putMVar'. The 'tryPutMVar' function+-- attempts to put the value @a@ into the 'MVar', returning 'True' if+-- it was successful, or 'False' otherwise.+tryPutMVar :: MVar a -> a -> IO Bool+tryPutMVar (MVar mvar#) x = IO $ \ s# ->+ case tryPutMVar# mvar# x s# of+ (# s, 0# #) -> (# s, False #)+ (# s, _ #) -> (# s, True #)++-- |Check whether a given 'MVar' is empty.+--+-- Notice that the boolean value returned is just a snapshot of+-- the state of the MVar. By the time you get to react on its result,+-- the MVar may have been filled (or emptied) - so be extremely+-- careful when using this operation. Use 'tryTakeMVar' instead if possible.+isEmptyMVar :: MVar a -> IO Bool+isEmptyMVar (MVar mv#) = IO $ \ s# -> + case isEmptyMVar# mv# s# of+ (# s2#, flg #) -> (# s2#, not (flg ==# 0#) #)++-- |Add a finalizer to an 'MVar' (GHC only). See "Foreign.ForeignPtr" and+-- "System.Mem.Weak" for more about finalizers.+addMVarFinalizer :: MVar a -> IO () -> IO ()+addMVarFinalizer (MVar m) finalizer = + IO $ \s -> case mkWeak# m () finalizer s of { (# s1, _ #) -> (# s1, () #) }+
GHC/Num.lhs view
@@ -180,8 +180,8 @@ jsplith p (n:ns) = case n `quotRemInteger` p of (# q, r #) ->- if q > 0 then fromInteger q : fromInteger r : jsplitb p ns- else fromInteger r : jsplitb p ns+ if q > 0 then q : r : jsplitb p ns+ else r : jsplitb p ns jsplith _ [] = error "jsplith: []" jsplitb :: Integer -> [Integer] -> [Integer]@@ -293,6 +293,8 @@ -- head (drop 1000000 [1 .. ] -- works +{-# NOINLINE [0] enumDeltaToIntegerFB #-}+-- Don't inline this until RULE "enumDeltaToInteger" has had a chance to fire enumDeltaToIntegerFB :: (Integer -> a -> a) -> a -> Integer -> Integer -> Integer -> a enumDeltaToIntegerFB c n x delta lim
GHC/PArr.hs view
@@ -507,7 +507,7 @@ | isLen /= esLen = error "GHC.PArr: arguments must be of the same length" | otherwise = runST (do marr <- newArray dftLen noElem- trans 0 (isLen - 1) marr dft copyOne noAL+ _ <- trans 0 (isLen - 1) marr dft copyOne noAL permute marr is es mkPArr dftLen marr) where
GHC/Pack.lhs view
@@ -35,7 +35,6 @@ where import GHC.Base-import GHC.Err ( error ) import GHC.List ( length ) import GHC.ST import GHC.Num
GHC/Ptr.lhs view
@@ -145,9 +145,7 @@ ------------------------------------------------------------------------ -- Show instances for Ptr and FunPtr--- I have absolutely no idea why the WORD_SIZE_IN_BITS stuff is here -#if (WORD_SIZE_IN_BITS == 32 || WORD_SIZE_IN_BITS == 64) instance Show (Ptr a) where showsPrec _ (Ptr a) rs = pad_out (showHex (wordToInteger(int2Word#(addr2Int# a))) "") where@@ -157,6 +155,5 @@ instance Show (FunPtr a) where showsPrec p = showsPrec p . castFunPtrToPtr-#endif \end{code}
GHC/Real.lhs view
@@ -4,7 +4,7 @@ ----------------------------------------------------------------------------- -- | -- Module : GHC.Real--- Copyright : (c) The FFI Task Force, 1994-2002+-- Copyright : (c) The University of Glasgow, 1994-2002 -- License : see libraries/base/LICENSE -- -- Maintainer : cvs-ghc@haskell.org@@ -24,6 +24,7 @@ import GHC.List import GHC.Enum import GHC.Show+import GHC.Err infixr 8 ^, ^^ infixl 7 /, `quot`, `rem`, `div`, `mod`@@ -448,6 +449,7 @@ lcm 0 _ = 0 lcm x y = abs ((x `quot` (gcd x y)) * y) +#ifdef OPTIMISE_INTEGER_GCD_LCM {-# RULES "gcd/Int->Int->Int" gcd = gcdInt "gcd/Integer->Integer->Integer" gcd = gcdInteger'@@ -460,6 +462,11 @@ gcdInteger' :: Integer -> Integer -> Integer gcdInteger' 0 0 = error "GHC.Real.gcdInteger': gcd 0 0 is undefined" gcdInteger' a b = gcdInteger a b++gcdInt :: Int -> Int -> Int+gcdInt 0 0 = error "GHC.Real.gcdInt: gcd 0 0 is undefined"+gcdInt a b = fromIntegral (gcdInteger (fromIntegral a) (fromIntegral b))+#endif integralEnumFrom :: (Integral a, Bounded a) => a -> [a] integralEnumFrom n = map fromInteger [toInteger n .. toInteger (maxBound `asTypeOf` n)]
GHC/Show.lhs view
@@ -388,7 +388,7 @@ itos :: Int# -> String -> String itos n# cs | n# <# 0# =- let I# minInt# = minInt in+ let !(I# minInt#) = minInt in if n# ==# minInt# -- negateInt# minInt overflows, so we can't do that: then '-' : itos' (negateInt# (n# `quotInt#` 10#))
+ GHC/Show.lhs-boot view
@@ -0,0 +1,10 @@+\begin{code}+{-# OPTIONS_GHC -XNoImplicitPrelude #-}++module GHC.Show (showSignedInt) where++import GHC.Types++showSignedInt :: Int -> Int -> [Char] -> [Char]+\end{code}+
GHC/Stable.lhs view
@@ -27,7 +27,7 @@ import GHC.Ptr import GHC.Base-import GHC.IOBase+-- import GHC.IO ----------------------------------------------------------------------------- -- Stable Pointers
GHC/Storable.lhs view
@@ -55,7 +55,6 @@ import GHC.Int import GHC.Word import GHC.Ptr-import GHC.IOBase import GHC.Base \end{code}
GHC/TopHandler.lhs view
@@ -36,8 +36,11 @@ import GHC.Conc hiding (throwTo) import GHC.Num import GHC.Real-import GHC.Handle-import GHC.IOBase+import GHC.MVar+import GHC.IO+import GHC.IO.Handle.FD+import GHC.IO.Handle+import GHC.IO.Exception import GHC.Weak import Data.Typeable #if defined(mingw32_HOST_OS)@@ -66,7 +69,7 @@ install_interrupt_handler :: IO () -> IO () #ifdef mingw32_HOST_OS install_interrupt_handler handler = do- GHC.ConsoleHandler.installHandler $+ _ <- GHC.ConsoleHandler.installHandler $ Catch $ \event -> case event of ControlC -> handler@@ -75,13 +78,13 @@ _ -> return () return () #else-#include "Signals.h"+#include "rts/Signals.h" -- specialised version of System.Posix.Signals.installHandler, which -- isn't available here. install_interrupt_handler handler = do let sig = CONST_SIGINT :: CInt- setHandler sig (Just (const handler, toDyn handler))- stg_sig_install sig STG_SIG_RST nullPtr+ _ <- setHandler sig (Just (const handler, toDyn handler))+ _ <- stg_sig_install sig STG_SIG_RST nullPtr -- STG_SIG_RST: the second ^C kills us for real, just in case the -- RTS or program is unresponsive. return ()@@ -160,8 +163,14 @@ Just ExitSuccess -> exit 0 Just (ExitFailure n) -> exit n - _ -> do reportError se- exit 1+ -- EPIPE errors received for stdout are ignored (#2699)+ _ -> case cast exn of+ Just IOError{ ioe_type = ResourceVanished,+ ioe_errno = Just ioe,+ ioe_handle = Just hdl }+ | Errno ioe == ePIPE, hdl == stdout -> exit 0+ _ -> do reportError se+ exit 1 -- try to flush stdout/stderr, but don't worry if we fail
GHC/Weak.lhs view
@@ -20,7 +20,6 @@ import GHC.Base import Data.Maybe-import GHC.IOBase ( IO(..), unIO ) import Data.Typeable {-|@@ -123,7 +122,7 @@ let go m = IO $ \s -> case m of 0# -> (# s, () #)- _ -> let m' = m -# 1# in+ _ -> let !m' = m -# 1# in case indexArray# arr m' of { (# io #) -> case unIO io s of { (# s', _ #) -> unIO (go m') s'
GHC/Word.hs view
@@ -41,6 +41,7 @@ import GHC.Read import GHC.Arr import GHC.Show+import GHC.Err ------------------------------------------------------------------------ -- Helper functions@@ -137,7 +138,7 @@ | i# >=# 0# = smallInteger i# | otherwise = wordToInteger x# where- i# = word2Int# x#+ !i# = word2Int# x# instance Bounded Word where minBound = 0@@ -166,7 +167,8 @@ (W# x#) .&. (W# y#) = W# (x# `and#` y#) (W# x#) .|. (W# y#) = W# (x# `or#` y#) (W# x#) `xor` (W# y#) = W# (x# `xor#` y#)- complement (W# x#) = W# (x# `xor#` mb#) where W# mb# = maxBound+ complement (W# x#) = W# (x# `xor#` mb#)+ where !(W# mb#) = maxBound (W# x#) `shift` (I# i#) | i# >=# 0# = W# (x# `shiftL#` i#) | otherwise = W# (x# `shiftRL#` negateInt# i#)@@ -174,8 +176,8 @@ | i'# ==# 0# = W# x# | otherwise = W# ((x# `uncheckedShiftL#` i'#) `or#` (x# `uncheckedShiftRL#` (wsib -# i'#))) where- i'# = word2Int# (int2Word# i# `and#` int2Word# (wsib -# 1#))- wsib = WORD_SIZE_IN_BITS# {- work around preprocessor problem (??) -}+ !i'# = word2Int# (int2Word# i# `and#` int2Word# (wsib -# 1#))+ !wsib = WORD_SIZE_IN_BITS# {- work around preprocessor problem (??) -} bitSize _ = WORD_SIZE_IN_BITS isSigned _ = False @@ -269,7 +271,8 @@ (W8# x#) .&. (W8# y#) = W8# (x# `and#` y#) (W8# x#) .|. (W8# y#) = W8# (x# `or#` y#) (W8# x#) `xor` (W8# y#) = W8# (x# `xor#` y#)- complement (W8# x#) = W8# (x# `xor#` mb#) where W8# mb# = maxBound+ complement (W8# x#) = W8# (x# `xor#` mb#)+ where !(W8# mb#) = maxBound (W8# x#) `shift` (I# i#) | i# >=# 0# = W8# (narrow8Word# (x# `shiftL#` i#)) | otherwise = W8# (x# `shiftRL#` negateInt# i#)@@ -278,7 +281,7 @@ | otherwise = W8# (narrow8Word# ((x# `uncheckedShiftL#` i'#) `or#` (x# `uncheckedShiftRL#` (8# -# i'#)))) where- i'# = word2Int# (int2Word# i# `and#` int2Word# 7#)+ !i'# = word2Int# (int2Word# i# `and#` int2Word# 7#) bitSize _ = 8 isSigned _ = False @@ -373,7 +376,8 @@ (W16# x#) .&. (W16# y#) = W16# (x# `and#` y#) (W16# x#) .|. (W16# y#) = W16# (x# `or#` y#) (W16# x#) `xor` (W16# y#) = W16# (x# `xor#` y#)- complement (W16# x#) = W16# (x# `xor#` mb#) where W16# mb# = maxBound+ complement (W16# x#) = W16# (x# `xor#` mb#)+ where !(W16# mb#) = maxBound (W16# x#) `shift` (I# i#) | i# >=# 0# = W16# (narrow16Word# (x# `shiftL#` i#)) | otherwise = W16# (x# `shiftRL#` negateInt# i#)@@ -382,7 +386,7 @@ | otherwise = W16# (narrow16Word# ((x# `uncheckedShiftL#` i'#) `or#` (x# `uncheckedShiftRL#` (16# -# i'#)))) where- i'# = word2Int# (int2Word# i# `and#` int2Word# 15#)+ !i'# = word2Int# (int2Word# i# `and#` int2Word# 15#) bitSize _ = 16 isSigned _ = False @@ -575,7 +579,7 @@ | i# >=# 0# = smallInteger i# | otherwise = wordToInteger x# where- i# = word2Int# x#+ !i# = word2Int# x# #else = smallInteger (word2Int# x#) #endif@@ -586,7 +590,8 @@ (W32# x#) .&. (W32# y#) = W32# (x# `and#` y#) (W32# x#) .|. (W32# y#) = W32# (x# `or#` y#) (W32# x#) `xor` (W32# y#) = W32# (x# `xor#` y#)- complement (W32# x#) = W32# (x# `xor#` mb#) where W32# mb# = maxBound+ complement (W32# x#) = W32# (x# `xor#` mb#)+ where !(W32# mb#) = maxBound (W32# x#) `shift` (I# i#) | i# >=# 0# = W32# (narrow32Word# (x# `shiftL#` i#)) | otherwise = W32# (x# `shiftRL#` negateInt# i#)@@ -595,7 +600,7 @@ | otherwise = W32# (narrow32Word# ((x# `uncheckedShiftL#` i'#) `or#` (x# `uncheckedShiftRL#` (32# -# i'#)))) where- i'# = word2Int# (int2Word# i# `and#` int2Word# 31#)+ !i'# = word2Int# (int2Word# i# `and#` int2Word# 31#) bitSize _ = 32 isSigned _ = False @@ -725,7 +730,7 @@ | otherwise = W64# ((x# `uncheckedShiftL64#` i'#) `or64#` (x# `uncheckedShiftRL64#` (64# -# i'#))) where- i'# = word2Int# (int2Word# i# `and#` int2Word# 63#)+ !i'# = word2Int# (int2Word# i# `and#` int2Word# 63#) bitSize _ = 64 isSigned _ = False @@ -815,7 +820,7 @@ | i# >=# 0# = smallInteger i# | otherwise = wordToInteger x# where- i# = word2Int# x#+ !i# = word2Int# x# instance Bits Word64 where {-# INLINE shift #-}@@ -823,7 +828,8 @@ (W64# x#) .&. (W64# y#) = W64# (x# `and#` y#) (W64# x#) .|. (W64# y#) = W64# (x# `or#` y#) (W64# x#) `xor` (W64# y#) = W64# (x# `xor#` y#)- complement (W64# x#) = W64# (x# `xor#` mb#) where W64# mb# = maxBound+ complement (W64# x#) = W64# (x# `xor#` mb#)+ where !(W64# mb#) = maxBound (W64# x#) `shift` (I# i#) | i# >=# 0# = W64# (x# `shiftL#` i#) | otherwise = W64# (x# `shiftRL#` negateInt# i#)@@ -832,7 +838,7 @@ | otherwise = W64# ((x# `uncheckedShiftL#` i'#) `or#` (x# `uncheckedShiftRL#` (64# -# i'#))) where- i'# = word2Int# (int2Word# i# `and#` int2Word# 63#)+ !i'# = word2Int# (int2Word# i# `and#` int2Word# 63#) bitSize _ = 64 isSigned _ = False
Prelude.hs view
@@ -1,4 +1,4 @@-{-# OPTIONS_GHC -XNoImplicitPrelude #-}+{-# OPTIONS_GHC -XNoImplicitPrelude -XBangPatterns #-} ----------------------------------------------------------------------------- -- | -- Module : Prelude@@ -146,6 +146,7 @@ #ifndef __HUGS__ import Control.Monad import System.IO+import System.IO.Error import Data.List import Data.Either import Data.Maybe@@ -154,18 +155,15 @@ #ifdef __GLASGOW_HASKELL__ import GHC.Base-import GHC.IOBase+-- import GHC.IO+-- import GHC.IO.Exception import Text.Read import GHC.Enum import GHC.Num import GHC.Real import GHC.Float import GHC.Show-import GHC.Err ( error, undefined )-#endif--#ifndef __HUGS__-import qualified Control.Exception.Base as New (catch)+import GHC.Err ( undefined ) #endif #ifdef __HUGS__@@ -174,12 +172,16 @@ #ifndef __HUGS__ infixr 0 $!+#endif -- ----------------------------------------------------------------------------- -- Miscellaneous functions -- | Strict (call-by-value) application, defined in terms of 'seq'. ($!) :: (a -> b) -> a -> b+#ifdef __GLASGOW_HASKELL__+f $! x = let !vx = x in f vx -- see #2273+#elif !defined(__HUGS__) f $! x = x `seq` f x #endif @@ -190,26 +192,3 @@ seq :: a -> b -> b seq _ y = y #endif--#ifndef __HUGS__--- | The 'catch' function establishes a handler that receives any 'IOError'--- raised in the action protected by 'catch'. An 'IOError' is caught by--- the most recent handler established by 'catch'. These handlers are--- not selective: all 'IOError's are caught. Exception propagation--- must be explicitly provided in a handler by re-raising any unwanted--- exceptions. For example, in------ > f = catch g (\e -> if IO.isEOFError e then return [] else ioError e)------ the function @f@ returns @[]@ when an end-of-file exception--- (cf. 'System.IO.Error.isEOFError') occurs in @g@; otherwise, the--- exception is propagated to the next outer handler.------ When an exception propagates outside the main program, the Haskell--- system prints the associated 'IOError' value and exits the program.------ Non-I\/O exceptions are not caught by this variant; to catch all--- exceptions, use 'Control.Exception.catch' from "Control.Exception".-catch :: IO a -> (IOError -> IO a) -> IO a-catch = New.catch-#endif /* !__HUGS__ */
− Prelude.hs-boot
@@ -1,7 +0,0 @@-{-# OPTIONS_GHC -XNoImplicitPrelude #-}--module Prelude where--import GHC.IOBase--catch :: IO a -> (IOError -> IO a) -> IO a
System/CPUTime.hsc view
@@ -34,9 +34,44 @@ import Foreign import Foreign.C -#include "HsBase.h"+#include "HsBaseConfig.h"++-- For _SC_CLK_TCK+#if HAVE_UNISTD_H+#include <unistd.h> #endif +-- For struct rusage+#if !defined(mingw32_HOST_OS) && !defined(irix_HOST_OS)+# if HAVE_SYS_RESOURCE_H+# include <sys/resource.h>+# endif+#endif++-- For FILETIME etc. on Windows+#if HAVE_WINDOWS_H+#include <windows.h>+#endif++-- for CLK_TCK+#if HAVE_TIME_H+#include <time.h>+#endif++-- for struct tms+#if HAVE_SYS_TIMES_H+#include <sys/times.h>+#endif++#endif++#if !defined(mingw32_HOST_OS) && !defined(cygwin32_HOST_OS)+realToInteger :: Real a => a -> Integer+realToInteger ct = round (realToFrac ct :: Double)+ -- CTime, CClock, CUShort etc are in Real but not Fractional, + -- so we must convert to Double before we can round it+#endif+ #ifdef __GLASGOW_HASKELL__ -- ----------------------------------------------------------------------------- -- |Computation 'getCPUTime' returns the number of picoseconds CPU time@@ -56,7 +91,7 @@ -- #if defined(HAVE_GETRUSAGE) && ! irix_HOST_OS && ! solaris2_HOST_OS allocaBytes (#const sizeof(struct rusage)) $ \ p_rusage -> do- getrusage (#const RUSAGE_SELF) p_rusage+ throwErrnoIfMinus1_ "getrusage" $ getrusage (#const RUSAGE_SELF) p_rusage let ru_utime = (#ptr struct rusage, ru_utime) p_rusage let ru_stime = (#ptr struct rusage, ru_stime) p_rusage@@ -64,7 +99,6 @@ u_usec <- (#peek struct timeval,tv_usec) ru_utime :: IO CTime s_sec <- (#peek struct timeval,tv_sec) ru_stime :: IO CTime s_usec <- (#peek struct timeval,tv_usec) ru_stime :: IO CTime- let realToInteger = round . realToFrac :: Real a => a -> Integer return ((realToInteger u_sec * 1000000 + realToInteger u_usec + realToInteger s_sec * 1000000 + realToInteger s_usec) * 1000000)@@ -77,7 +111,6 @@ times p_tms u_ticks <- (#peek struct tms,tms_utime) p_tms :: IO CClock s_ticks <- (#peek struct tms,tms_stime) p_tms :: IO CClock- let realToInteger = round . realToFrac :: Real a => a -> Integer return (( (realToInteger u_ticks + realToInteger s_ticks) * 1000000000000) `div` fromIntegral clockTicks) @@ -112,7 +145,7 @@ low <- (#peek FILETIME,dwLowDateTime) ft :: IO Word32 -- Convert 100-ns units to picosecs (10^-12) -- => multiply by 10^5.- return (((fromIntegral high) * (2^32) + (fromIntegral low)) * 100000)+ return (((fromIntegral high) * (2^(32::Int)) + (fromIntegral low)) * 100000) -- ToDo: pin down elapsed times to just the OS thread(s) that -- are evaluating/managing Haskell code.
System/Environment.hs view
@@ -34,7 +34,8 @@ import Foreign.C import Control.Exception.Base ( bracket ) import Control.Monad-import GHC.IOBase+-- import GHC.IO+import GHC.IO.Exception #endif #ifdef __HUGS__@@ -123,7 +124,7 @@ if litstring /= nullPtr then peekCString litstring else ioException (IOError Nothing NoSuchThing "getEnv"- "no environment variable" (Just name))+ "no environment variable" Nothing (Just name)) foreign import ccall unsafe "getenv" c_getenv :: CString -> IO (Ptr CChar)@@ -154,7 +155,8 @@ pName <- System.Environment.getProgName existing_args <- System.Environment.getArgs bracket (setArgs new_args)- (\argv -> do setArgs (pName:existing_args); freeArgv argv)+ (\argv -> do _ <- setArgs (pName:existing_args)+ freeArgv argv) (const act) freeArgv :: Ptr CString -> IO ()
System/Exit.hs view
@@ -23,7 +23,8 @@ import Prelude #ifdef __GLASGOW_HASKELL__-import GHC.IOBase+import GHC.IO+import GHC.IO.Exception #endif #ifdef __HUGS__@@ -57,14 +58,19 @@ -- be caught using the functions of "Control.Exception". This means -- that cleanup computations added with 'Control.Exception.bracket' -- (from "Control.Exception") are also executed properly on 'exitWith'.-+--+-- Note: in GHC, 'exitWith' should be called from the main program+-- thread in order to exit the process. When called from another+-- thread, 'exitWith' will throw an 'ExitException' as normal, but the+-- exception will not cause the process itself to exit.+-- #ifndef __NHC__ exitWith :: ExitCode -> IO a exitWith ExitSuccess = throwIO ExitSuccess exitWith code@(ExitFailure n) | n /= 0 = throwIO code #ifdef __GLASGOW_HASKELL__- | otherwise = ioError (IOError Nothing InvalidArgument "exitWith" "ExitFailure 0" Nothing)+ | otherwise = ioError (IOError Nothing InvalidArgument "exitWith" "ExitFailure 0" Nothing Nothing) #endif #endif /* ! __NHC__ */
System/IO.hs view
@@ -159,6 +159,65 @@ openTempFile, openBinaryTempFile,+ openTempFileWithDefaultPermissions,+ openBinaryTempFileWithDefaultPermissions,++#if !defined(__NHC__) && !defined(__HUGS__)+ -- * Unicode encoding\/decoding++ -- | A text-mode 'Handle' has an associated 'TextEncoding', which+ -- is used to decode bytes into Unicode characters when reading,+ -- and encode Unicode characters into bytes when writing.+ --+ -- The default 'TextEncoding' is the same as the default encoding+ -- on your system, which is also available as 'localeEncoding'.+ -- (GHC note: on Windows, we currently do not support double-byte+ -- encodings; if the console\'s code page is unsupported, then+ -- 'localeEncoding' will be 'latin1'.)+ --+ -- Encoding and decoding errors are always detected and reported,+ -- except during lazy I/O ('hGetContents', 'getContents', and+ -- 'readFile'), where a decoding error merely results in+ -- termination of the character stream, as with other I/O errors.++ hSetEncoding, + hGetEncoding,++ -- ** Unicode encodings+ TextEncoding, + latin1,+ utf8, utf8_bom,+ utf16, utf16le, utf16be,+ utf32, utf32le, utf32be, + localeEncoding,+ mkTextEncoding,+#endif++#if !defined(__NHC__) && !defined(__HUGS__)+ -- * Newline conversion+ + -- | In Haskell, a newline is always represented by the character+ -- '\n'. However, in files and external character streams, a+ -- newline may be represented by another character sequence, such+ -- as '\r\n'.+ --+ -- A text-mode 'Handle' has an associated 'NewlineMode' that+ -- specifies how to transate newline characters. The+ -- 'NewlineMode' specifies the input and output translation+ -- separately, so that for instance you can translate '\r\n'+ -- to '\n' on input, but leave newlines as '\n' on output.+ --+ -- The default 'NewlineMode' for a 'Handle' is+ -- 'nativeNewlineMode', which does no translation on Unix systems,+ -- but translates '\r\n' to '\n' and back on Windows.+ --+ -- Binary-mode 'Handle's do no newline translation at all.+ --+ hSetNewlineMode, + Newline(..), nativeNewline, + NewlineMode(..), + noNewlineTranslation, universalNewlineMode, nativeNewlineMode,+#endif ) where import Control.Exception.Base@@ -168,17 +227,20 @@ import Data.List import Data.Maybe import Foreign.C.Error-import Foreign.C.String import Foreign.C.Types import System.Posix.Internals+import System.Posix.Types #endif #ifdef __GLASGOW_HASKELL__ import GHC.Base-import GHC.IOBase -- Together these four Prelude modules define-import GHC.Handle -- all the stuff exported by IO for the GHC version-import GHC.IO-import GHC.Exception+import GHC.IO hiding ( onException )+import GHC.IO.IOMode+import GHC.IO.Handle.FD+import GHC.IO.Handle+import GHC.IORef+import GHC.IO.Exception ( userError )+import GHC.IO.Encoding import GHC.Num import Text.Read import GHC.Show@@ -428,14 +490,29 @@ -- the created file will be \"fooXXX.ext\" where XXX is some -- random number. -> IO (FilePath, Handle)-openTempFile tmp_dir template = openTempFile' "openTempFile" tmp_dir template False+openTempFile tmp_dir template+ = openTempFile' "openTempFile" tmp_dir template False 0o600 -- | Like 'openTempFile', but opens the file in binary mode. See 'openBinaryFile' for more comments. openBinaryTempFile :: FilePath -> String -> IO (FilePath, Handle)-openBinaryTempFile tmp_dir template = openTempFile' "openBinaryTempFile" tmp_dir template True+openBinaryTempFile tmp_dir template+ = openTempFile' "openBinaryTempFile" tmp_dir template True 0o600 -openTempFile' :: String -> FilePath -> String -> Bool -> IO (FilePath, Handle)-openTempFile' loc tmp_dir template binary = do+-- | Like 'openTempFile', but uses the default file permissions+openTempFileWithDefaultPermissions :: FilePath -> String+ -> IO (FilePath, Handle)+openTempFileWithDefaultPermissions tmp_dir template+ = openTempFile' "openBinaryTempFile" tmp_dir template False 0o666++-- | Like 'openBinaryTempFile', but uses the default file permissions+openBinaryTempFileWithDefaultPermissions :: FilePath -> String+ -> IO (FilePath, Handle)+openBinaryTempFileWithDefaultPermissions tmp_dir template+ = openTempFile' "openBinaryTempFile" tmp_dir template True 0o666++openTempFile' :: String -> FilePath -> String -> Bool -> CMode+ -> IO (FilePath, Handle)+openTempFile' loc tmp_dir template binary mode = do pid <- c_getpid findTempName pid where@@ -471,8 +548,8 @@ return (filepath, h) #else findTempName x = do- fd <- withCString filepath $ \ f ->- c_open f oflags 0o600+ fd <- withFilePath filepath $ \ f ->+ c_open f oflags mode if fd < 0 then do errno <- getErrno
System/IO/Error.hs view
@@ -21,13 +21,11 @@ userError, -- :: String -> IOError -#ifndef __NHC__ mkIOError, -- :: IOErrorType -> String -> Maybe Handle -- -> Maybe FilePath -> IOError annotateIOError, -- :: IOError -> String -> Maybe Handle -- -> Maybe FilePath -> IOError-#endif -- ** Classifying I\/O errors isAlreadyExistsError, -- :: IOError -> Bool@@ -40,21 +38,17 @@ isUserError, -- ** Attributes of I\/O errors-#ifndef __NHC__ ioeGetErrorType, -- :: IOError -> IOErrorType ioeGetLocation, -- :: IOError -> String-#endif ioeGetErrorString, -- :: IOError -> String ioeGetHandle, -- :: IOError -> Maybe Handle ioeGetFileName, -- :: IOError -> Maybe FilePath -#ifndef __NHC__ ioeSetErrorType, -- :: IOError -> IOErrorType -> IOError ioeSetErrorString, -- :: IOError -> String -> IOError ioeSetLocation, -- :: IOError -> String -> IOError ioeSetHandle, -- :: IOError -> Handle -> IOError ioeSetFileName, -- :: IOError -> FilePath -> IOError-#endif -- * Types of I\/O error IOErrorType, -- abstract@@ -85,21 +79,23 @@ catch, -- :: IO a -> (IOError -> IO a) -> IO a try, -- :: IO a -> IO (Either IOError a) -#ifndef __NHC__ modifyIOError, -- :: (IOError -> IOError) -> IO a -> IO a-#endif ) where #ifndef __HUGS__+import qualified Control.Exception.Base as New (catch)+#endif++#ifndef __HUGS__ import Data.Either #endif import Data.Maybe #ifdef __GLASGOW_HASKELL__-import {-# SOURCE #-} Prelude (catch)- import GHC.Base-import GHC.IOBase+import GHC.IO+import GHC.IO.Exception+import GHC.IO.Handle.Types import Text.Show #endif @@ -110,6 +106,7 @@ #ifdef __NHC__ import IO ( IOError ()+ , Handle () , try , ioError , userError@@ -125,8 +122,10 @@ , ioeGetHandle -- :: IOError -> Maybe Handle , ioeGetFileName -- :: IOError -> Maybe FilePath )---import Data.Maybe (fromJust)---import Control.Monad (MonadPlus(mplus))+import qualified NHC.Internal as NHC (IOError(..))+import qualified NHC.DErrNo as NHC (ErrNo(..))+import Data.Maybe (fromJust)+import Control.Monad (MonadPlus(mplus)) #endif -- | The construct 'try' @comp@ exposes IO errors which occur within a@@ -155,25 +154,28 @@ IOError{ ioe_type = t, ioe_location = location, ioe_description = "",+#if defined(__GLASGOW_HASKELL__)+ ioe_errno = Nothing,+#endif ioe_handle = maybe_hdl, ioe_filename = maybe_filename }+#endif /* __GLASGOW_HASKELL__ || __HUGS__ */ #ifdef __NHC__ mkIOError EOF location maybe_hdl maybe_filename =- EOFError location (fromJust maybe_hdl)+ NHC.EOFError location (fromJust maybe_hdl) mkIOError UserError location maybe_hdl maybe_filename =- UserError location ""+ NHC.UserError location "" mkIOError t location maybe_hdl maybe_filename =- NHC.FFI.mkIOError location maybe_filename maybe_handle (ioeTypeToInt t)+ NHC.IOError location maybe_filename maybe_hdl (ioeTypeToErrNo t) where- ioeTypeToInt AlreadyExists = fromEnum EEXIST- ioeTypeToInt NoSuchThing = fromEnum ENOENT- ioeTypeToInt ResourceBusy = fromEnum EBUSY- ioeTypeToInt ResourceExhausted = fromEnum ENOSPC- ioeTypeToInt IllegalOperation = fromEnum EPERM- ioeTypeToInt PermissionDenied = fromEnum EACCES-#endif-#endif /* __GLASGOW_HASKELL__ || __HUGS__ */+ ioeTypeToErrNo AlreadyExists = NHC.EEXIST+ ioeTypeToErrNo NoSuchThing = NHC.ENOENT+ ioeTypeToErrNo ResourceBusy = NHC.EBUSY+ ioeTypeToErrNo ResourceExhausted = NHC.ENOSPC+ ioeTypeToErrNo IllegalOperation = NHC.EPERM+ ioeTypeToErrNo PermissionDenied = NHC.EACCES+#endif /* __NHC__ */ #ifndef __NHC__ -- -----------------------------------------------------------------------------@@ -354,6 +356,47 @@ ioeSetHandle ioe hdl = ioe{ ioe_handle = Just hdl } ioeSetFileName ioe filename = ioe{ ioe_filename = Just filename } +#elif defined(__NHC__)+ioeGetErrorType :: IOError -> IOErrorType+ioeGetLocation :: IOError -> String++ioeGetErrorType e | isAlreadyExistsError e = AlreadyExists+ | isDoesNotExistError e = NoSuchThing+ | isAlreadyInUseError e = ResourceBusy+ | isFullError e = ResourceExhausted+ | isEOFError e = EOF+ | isIllegalOperation e = IllegalOperation+ | isPermissionError e = PermissionDenied+ | isUserError e = UserError++ioeGetLocation (NHC.IOError _ _ _ _) = "unknown location"+ioeGetLocation (NHC.EOFError _ _ ) = "unknown location"+ioeGetLocation (NHC.PatternError loc) = loc+ioeGetLocation (NHC.UserError loc _) = loc++ioeSetErrorType :: IOError -> IOErrorType -> IOError+ioeSetErrorString :: IOError -> String -> IOError+ioeSetLocation :: IOError -> String -> IOError+ioeSetHandle :: IOError -> Handle -> IOError+ioeSetFileName :: IOError -> FilePath -> IOError++ioeSetErrorType e _ = e+ioeSetErrorString (NHC.IOError _ f h e) s = NHC.IOError s f h e+ioeSetErrorString (NHC.EOFError _ f) s = NHC.EOFError s f+ioeSetErrorString e@(NHC.PatternError _) _ = e+ioeSetErrorString (NHC.UserError l _) s = NHC.UserError l s+ioeSetLocation e@(NHC.IOError _ _ _ _) _ = e+ioeSetLocation e@(NHC.EOFError _ _) _ = e+ioeSetLocation (NHC.PatternError _) l = NHC.PatternError l+ioeSetLocation (NHC.UserError _ m) l = NHC.UserError l m+ioeSetHandle (NHC.IOError o f _ e) h = NHC.IOError o f (Just h) e+ioeSetHandle (NHC.EOFError o _) h = NHC.EOFError o h+ioeSetHandle e@(NHC.PatternError _) _ = e+ioeSetHandle e@(NHC.UserError _ _) _ = e+ioeSetFileName (NHC.IOError o _ h e) f = NHC.IOError o (Just f) h e+ioeSetFileName e _ = e+#endif+ -- | Catch any 'IOError' that occurs in the computation and throw a -- modified version. modifyIOError :: (IOError -> IOError) -> IO a -> IO a@@ -370,20 +413,46 @@ -> Maybe Handle -> Maybe FilePath -> IOError -annotateIOError (IOError ohdl errTy _ str opath) loc hdl path = - IOError (hdl `mplus` ohdl) errTy loc str (path `mplus` opath)++#if defined(__GLASGOW_HASKELL__) || defined(__HUGS__)+annotateIOError ioe loc hdl path = + ioe{ ioe_handle = hdl `mplus` ioe_handle ioe,+ ioe_location = loc, ioe_filename = path `mplus` ioe_filename ioe } where Nothing `mplus` ys = ys xs `mplus` _ = xs #endif /* __GLASGOW_HASKELL__ || __HUGS__ */ -#if 0 /*__NHC__*/-annotateIOError (IOError msg file hdl code) msg' file' hdl' =- IOError (msg++'\n':msg') (file`mplus`file') (hdl`mplus`hdl') code-annotateIOError (EOFError msg hdl) msg' file' hdl' =- EOFError (msg++'\n':msg') (hdl`mplus`hdl')-annotateIOError (UserError loc msg) msg' file' hdl' =- UserError loc (msg++'\n':msg')-annotateIOError (PatternError loc) msg' file' hdl' =- PatternError (loc++'\n':msg')+#if defined(__NHC__)+annotateIOError (NHC.IOError msg file hdl code) msg' hdl' file' =+ NHC.IOError (msg++'\n':msg') (file`mplus`file') (hdl`mplus`hdl') code+annotateIOError (NHC.EOFError msg hdl) msg' _ _ =+ NHC.EOFError (msg++'\n':msg') hdl+annotateIOError (NHC.UserError loc msg) msg' _ _ =+ NHC.UserError loc (msg++'\n':msg')+annotateIOError (NHC.PatternError loc) msg' _ _ =+ NHC.PatternError (loc++'\n':msg') #endif++#ifndef __HUGS__+-- | The 'catch' function establishes a handler that receives any 'IOError'+-- raised in the action protected by 'catch'. An 'IOError' is caught by+-- the most recent handler established by 'catch'. These handlers are+-- not selective: all 'IOError's are caught. Exception propagation+-- must be explicitly provided in a handler by re-raising any unwanted+-- exceptions. For example, in+--+-- > f = catch g (\e -> if IO.isEOFError e then return [] else ioError e)+--+-- the function @f@ returns @[]@ when an end-of-file exception+-- (cf. 'System.IO.Error.isEOFError') occurs in @g@; otherwise, the+-- exception is propagated to the next outer handler.+--+-- When an exception propagates outside the main program, the Haskell+-- system prints the associated 'IOError' value and exits the program.+--+-- Non-I\/O exceptions are not caught by this variant; to catch all+-- exceptions, use 'Control.Exception.catch' from "Control.Exception".+catch :: IO a -> (IOError -> IO a) -> IO a+catch = New.catch+#endif /* !__HUGS__ */
System/IO/Unsafe.hs view
@@ -20,7 +20,7 @@ ) where #ifdef __GLASGOW_HASKELL__-import GHC.IOBase (unsafePerformIO, unsafeInterleaveIO)+import GHC.IO (unsafePerformIO, unsafeInterleaveIO) #endif #ifdef __HUGS__
System/Mem/StableName.hs view
@@ -38,7 +38,7 @@ #endif #ifdef __GLASGOW_HASKELL__-import GHC.IOBase ( IO(..) )+import GHC.IO ( IO(..) ) import GHC.Base ( Int(..), StableName#, makeStableName# , eqStableName#, stableNameToInt# )
System/Mem/Weak.hs view
@@ -104,7 +104,7 @@ -} addFinalizer :: key -> IO () -> IO () addFinalizer key finalizer = do- mkWeakPtr key (Just finalizer) -- throw it away+ _ <- mkWeakPtr key (Just finalizer) -- throw it away return () -- | A specialised version of 'mkWeak' where the value is actually a pair
System/Posix/Internals.hs view
@@ -23,7 +23,11 @@ -- #hide module System.Posix.Internals where -#include "HsBaseConfig.h"+#ifdef __NHC__+#define HTYPE_TCFLAG_T+#else+# include "HsBaseConfig.h"+#endif #if ! (defined(mingw32_HOST_OS) || defined(__MINGW32__)) import Control.Monad@@ -33,30 +37,38 @@ import Foreign import Foreign.C -import Data.Bits+-- import Data.Bits import Data.Maybe +#if !defined(HTYPE_TCFLAG_T)+import System.IO.Error+#endif+ #if __GLASGOW_HASKELL__ import GHC.Base import GHC.Num import GHC.Real-import GHC.IOBase+import GHC.IO+import GHC.IO.IOMode+import GHC.IO.Exception+import GHC.IO.Device #elif __HUGS__ import Hugs.Prelude (IOException(..), IOErrorType(..)) import Hugs.IO (IOMode(..))-#else+#elif __NHC__+import GHC.IO.Device -- yes, I know, but its portable, really! import System.IO+import Control.Exception+import DIOError #endif #ifdef __HUGS__-{-# CFILES cbits/PrelIOUtils.c cbits/dirUtils.c cbits/consUtils.c #-}+{-# CFILES cbits/PrelIOUtils.c cbits/consUtils.c #-} #endif -- --------------------------------------------------------------------------- -- Types -type CDir = ()-type CDirent = () type CFLock = () type CGroup = () type CLconv = ()@@ -70,9 +82,7 @@ type CUtimbuf = () type CUtsname = () -#ifndef __GLASGOW_HASKELL__ type FD = CInt-#endif -- --------------------------------------------------------------------------- -- stat()-related stuff@@ -80,42 +90,39 @@ fdFileSize :: FD -> IO Integer fdFileSize fd = allocaBytes sizeof_stat $ \ p_stat -> do- throwErrnoIfMinus1Retry "fileSize" $+ throwErrnoIfMinus1Retry_ "fileSize" $ c_fstat fd p_stat c_mode <- st_mode p_stat :: IO CMode if not (s_isreg c_mode) then return (-1) else do- c_size <- st_size p_stat- return (fromIntegral c_size)--data FDType = Directory | Stream | RegularFile | RawDevice- deriving (Eq)+ c_size <- st_size p_stat+ return (fromIntegral c_size) -fileType :: FilePath -> IO FDType+fileType :: FilePath -> IO IODeviceType fileType file = allocaBytes sizeof_stat $ \ p_stat -> do- withCString file $ \p_file -> do- throwErrnoIfMinus1Retry "fileType" $+ withFilePath file $ \p_file -> do+ throwErrnoIfMinus1Retry_ "fileType" $ c_stat p_file p_stat statGetType p_stat -- NOTE: On Win32 platforms, this will only work with file descriptors -- referring to file handles. i.e., it'll fail for socket FDs.-fdStat :: FD -> IO (FDType, CDev, CIno)+fdStat :: FD -> IO (IODeviceType, CDev, CIno) fdStat fd = allocaBytes sizeof_stat $ \ p_stat -> do- throwErrnoIfMinus1Retry "fdType" $+ throwErrnoIfMinus1Retry_ "fdType" $ c_fstat fd p_stat ty <- statGetType p_stat dev <- st_dev p_stat ino <- st_ino p_stat return (ty,dev,ino) -fdType :: FD -> IO FDType+fdType :: FD -> IO IODeviceType fdType fd = do (ty,_,_) <- fdStat fd; return ty -statGetType :: Ptr CStat -> IO FDType+statGetType :: Ptr CStat -> IO IODeviceType statGetType p_stat = do c_mode <- st_mode p_stat :: IO CMode case () of@@ -128,17 +135,15 @@ | otherwise -> ioError ioe_unknownfiletype ioe_unknownfiletype :: IOException+#ifndef __NHC__ ioe_unknownfiletype = IOError Nothing UnsupportedOperation "fdType"- "unknown file type" Nothing--#if __GLASGOW_HASKELL__ && (defined(mingw32_HOST_OS) || defined(__MINGW32__))-closeFd :: Bool -> CInt -> IO CInt-closeFd isStream fd - | isStream = c_closesocket fd- | otherwise = c_close fd--foreign import stdcall unsafe "HsBase.h closesocket"- c_closesocket :: CInt -> IO CInt+ "unknown file type"+# if __GLASGOW_HASKELL__+ Nothing+# endif+ Nothing+#else+ioe_unknownfiletype = UserError "fdType" "unknown file type" #endif fdGetMode :: FD -> IO IOMode@@ -165,12 +170,17 @@ return mode +#ifdef mingw32_HOST_OS+withFilePath :: FilePath -> (CWString -> IO a) -> IO a+withFilePath = withCWString +#else+withFilePath :: FilePath -> (CString -> IO a) -> IO a+withFilePath = withCString+#endif+ -- --------------------------------------------------------------------------- -- Terminal-related stuff -fdIsTTY :: FD -> IO Bool-fdIsTTY fd = c_isatty fd >>= return.toBool- #if defined(HTYPE_TCFLAG_T) setEcho :: FD -> Bool -> IO ()@@ -209,7 +219,7 @@ tcSetAttr :: FD -> (Ptr CTermios -> IO a) -> IO a tcSetAttr fd fun = do allocaBytes sizeof_termios $ \p_tios -> do- throwErrnoIfMinus1Retry "tcSetAttr"+ throwErrnoIfMinus1Retry_ "tcSetAttr" (c_tcgetattr fd p_tios) #ifdef __GLASGOW_HASKELL__@@ -229,14 +239,18 @@ -- wrapper which temporarily blocks SIGTTOU around the call, making it -- transparent. allocaBytes sizeof_sigset_t $ \ p_sigset -> do- allocaBytes sizeof_sigset_t $ \ p_old_sigset -> do- c_sigemptyset p_sigset- c_sigaddset p_sigset const_sigttou- c_sigprocmask const_sig_block p_sigset p_old_sigset+ allocaBytes sizeof_sigset_t $ \ p_old_sigset -> do+ throwErrnoIfMinus1_ "sigemptyset" $+ c_sigemptyset p_sigset+ throwErrnoIfMinus1_ "sigaddset" $+ c_sigaddset p_sigset const_sigttou+ throwErrnoIfMinus1_ "sigprocmask" $+ c_sigprocmask const_sig_block p_sigset p_old_sigset r <- fun p_tios -- do the business throwErrnoIfMinus1Retry_ "tcSetAttr" $ c_tcsetattr fd const_tcsanow p_tios- c_sigprocmask const_sig_setmask p_old_sigset nullPtr+ throwErrnoIfMinus1_ "sigprocmask" $+ c_sigprocmask const_sig_setmask p_old_sigset nullPtr return r #ifdef __GLASGOW_HASKELL__@@ -266,7 +280,11 @@ ioe_unk_error :: String -> String -> IOException ioe_unk_error loc msg - = IOError Nothing OtherError loc msg Nothing+#ifndef __NHC__+ = ioeSetErrorString (mkIOError OtherError loc Nothing Nothing) msg+#else+ = UserError loc msg+#endif -- Note: echoing goes hand in hand with enabling 'line input' / raw-ness -- for Win32 consoles, hence setEcho ends up being the inverse of setCooked.@@ -298,21 +316,23 @@ -- --------------------------------------------------------------------------- -- Turning on non-blocking for a file descriptor -setNonBlockingFD :: FD -> IO ()+setNonBlockingFD :: FD -> Bool -> IO () #if !defined(mingw32_HOST_OS) && !defined(__MINGW32__)-setNonBlockingFD fd = do+setNonBlockingFD fd set = do flags <- throwErrnoIfMinus1Retry "setNonBlockingFD" (c_fcntl_read fd const_f_getfl) -- An error when setting O_NONBLOCK isn't fatal: on some systems -- there are certain file handles on which this will fail (eg. /dev/null -- on FreeBSD) so we throw away the return code from fcntl_write.- unless (testBit flags (fromIntegral o_NONBLOCK)) $ do- c_fcntl_write fd const_f_setfl (fromIntegral (flags .|. o_NONBLOCK))- return ()+ let flags' | set = flags .|. o_NONBLOCK+ | otherwise = flags .&. complement o_NONBLOCK+ unless (flags == flags') $ do+ throwErrnoIfMinus1Retry_ "fcntl_write" $+ c_fcntl_write fd const_f_setfl (fromIntegral flags') #else -- bogus defns for win32-setNonBlockingFD _ = return ()+setNonBlockingFD _ _ = return () #endif @@ -322,14 +342,19 @@ #if !defined(mingw32_HOST_OS) && !defined(__MINGW32__) setCloseOnExec :: FD -> IO () setCloseOnExec fd = do- throwErrnoIfMinus1 "setCloseOnExec" $+ throwErrnoIfMinus1_ "setCloseOnExec" $ c_fcntl_write fd const_f_setfd const_fd_cloexec- return () #endif -- ----------------------------------------------------------------------------- -- foreign imports +#if !defined(mingw32_HOST_OS) && !defined(__MINGW32__)+type CFilePath = CString+#else+type CFilePath = CWString+#endif+ foreign import ccall unsafe "HsBase.h access" c_access :: CString -> CInt -> IO CInt @@ -339,9 +364,6 @@ foreign import ccall unsafe "HsBase.h close" c_close :: CInt -> IO CInt -foreign import ccall unsafe "HsBase.h closedir" - c_closedir :: Ptr CDir -> IO CInt- foreign import ccall unsafe "HsBase.h creat" c_creat :: CString -> CMode -> IO CInt @@ -366,32 +388,29 @@ #endif foreign import ccall unsafe "HsBase.h __hscore_lstat"- lstat :: CString -> Ptr CStat -> IO CInt--foreign import ccall unsafe "HsBase.h __hscore_open"- c_open :: CString -> CInt -> CMode -> IO CInt--foreign import ccall unsafe "HsBase.h opendir" - c_opendir :: CString -> IO (Ptr CDir)+ lstat :: CFilePath -> Ptr CStat -> IO CInt -foreign import ccall unsafe "HsBase.h __hscore_mkdir"- mkdir :: CString -> CInt -> IO CInt+foreign import ccall unsafe "__hscore_open"+ c_open :: CFilePath -> CInt -> CMode -> IO CInt foreign import ccall unsafe "HsBase.h read" - c_read :: CInt -> Ptr CChar -> CSize -> IO CSsize+ c_read :: CInt -> Ptr Word8 -> CSize -> IO CSsize -foreign import ccall unsafe "HsBase.h rewinddir"- c_rewinddir :: Ptr CDir -> IO ()+foreign import ccall safe "read"+ c_safe_read :: CInt -> Ptr Word8 -> CSize -> IO CSsize -foreign import ccall unsafe "HsBase.h __hscore_stat"- c_stat :: CString -> Ptr CStat -> IO CInt+foreign import ccall unsafe "__hscore_stat"+ c_stat :: CFilePath -> Ptr CStat -> IO CInt foreign import ccall unsafe "HsBase.h umask" c_umask :: CMode -> IO CMode foreign import ccall unsafe "HsBase.h write" - c_write :: CInt -> Ptr CChar -> CSize -> IO CSsize+ c_write :: CInt -> Ptr Word8 -> CSize -> IO CSsize +foreign import ccall safe "write"+ c_safe_write :: CInt -> Ptr Word8 -> CSize -> IO CSsize+ foreign import ccall unsafe "HsBase.h __hscore_ftruncate" c_ftruncate :: CInt -> COff -> IO CInt @@ -402,13 +421,13 @@ c_getpid :: IO CPid #if !defined(mingw32_HOST_OS) && !defined(__MINGW32__)-foreign import ccall unsafe "HsBase.h fcntl"+foreign import ccall unsafe "HsBase.h fcntl_read" c_fcntl_read :: CInt -> CInt -> IO CInt -foreign import ccall unsafe "HsBase.h fcntl"+foreign import ccall unsafe "HsBase.h fcntl_write" c_fcntl_write :: CInt -> CInt -> CLong -> IO CInt -foreign import ccall unsafe "HsBase.h fcntl"+foreign import ccall unsafe "HsBase.h fcntl_lock" c_fcntl_lock :: CInt -> CInt -> Ptr CFLock -> IO CInt foreign import ccall unsafe "HsBase.h fork"@@ -438,26 +457,13 @@ foreign import ccall unsafe "HsBase.h tcsetattr" c_tcsetattr :: CInt -> CInt -> Ptr CTermios -> IO CInt -foreign import ccall unsafe "HsBase.h utime"+foreign import ccall unsafe "HsBase.h __hscore_utime" c_utime :: CString -> Ptr CUtimbuf -> IO CInt foreign import ccall unsafe "HsBase.h waitpid" c_waitpid :: CPid -> Ptr CInt -> CInt -> IO CPid #endif --- traversing directories-foreign import ccall unsafe "dirUtils.h __hscore_readdir"- readdir :: Ptr CDir -> Ptr (Ptr CDirent) -> IO CInt- -foreign import ccall unsafe "HsBase.h __hscore_free_dirent"- freeDirEnt :: Ptr CDirent -> IO ()- -foreign import ccall unsafe "HsBase.h __hscore_end_of_dir"- end_of_dir :: CInt- -foreign import ccall unsafe "HsBase.h __hscore_d_name"- d_name :: Ptr CDirent -> IO CString- -- POSIX flags only: foreign import ccall unsafe "HsBase.h __hscore_o_rdonly" o_RDONLY :: CInt foreign import ccall unsafe "HsBase.h __hscore_o_wronly" o_WRONLY :: CInt@@ -529,3 +535,8 @@ #else s_issock _ = False #endif++foreign import ccall unsafe "__hscore_bufsiz" dEFAULT_BUFFER_SIZE :: Int+foreign import ccall unsafe "__hscore_seek_cur" sEEK_CUR :: CInt+foreign import ccall unsafe "__hscore_seek_set" sEEK_SET :: CInt+foreign import ccall unsafe "__hscore_seek_end" sEEK_END :: CInt
System/Posix/Types.hs view
@@ -111,14 +111,14 @@ import Foreign import Foreign.C import Data.Typeable-import Data.Bits+-- import Data.Bits #ifdef __GLASGOW_HASKELL__ import GHC.Base import GHC.Enum import GHC.Num import GHC.Real-import GHC.Prim+-- import GHC.Prim import GHC.Read import GHC.Show #else
System/Timeout.hs view
@@ -27,6 +27,7 @@ import Control.Exception (Exception, handleJust, throwTo, bracket) import Data.Typeable import Data.Unique (Unique, newUnique)+import GHC.Num -- An internal type that is thrown as a dynamic exception to -- interrupt the running IO computation when the timeout has
Text/ParserCombinators/ReadP.hs view
@@ -35,6 +35,7 @@ -- * Other operations pfail, -- :: ReadP a+ eof, -- :: ReadP () satisfy, -- :: (Char -> Bool) -> ReadP Char char, -- :: Char -> ReadP Char string, -- :: String -> ReadP String@@ -76,7 +77,7 @@ #ifndef __HADDOCK__ import {-# SOURCE #-} GHC.Unicode ( isSpace ) #endif-import GHC.List ( replicate )+import GHC.List ( replicate, null ) import GHC.Base #else import Data.Char( isSpace )@@ -275,25 +276,35 @@ -- ^ Parses and returns the specified character. char c = satisfy (c ==) +eof :: ReadP ()+-- ^ Succeeds iff we are at the end of input+eof = do { s <- look + ; if null s then return () + else pfail }+ string :: String -> ReadP String -- ^ Parses and returns the specified string. string this = do s <- look; scan this s where scan [] _ = do return this- scan (x:xs) (y:ys) | x == y = do get; scan xs ys+ scan (x:xs) (y:ys) | x == y = do _ <- get; scan xs ys scan _ _ = do pfail munch :: (Char -> Bool) -> ReadP String -- ^ Parses the first zero or more characters satisfying the predicate.+-- Always succeds, exactly once having consumed all the characters+-- Hence NOT the same as (many (satisfy p)) munch p = do s <- look scan s where- scan (c:cs) | p c = do get; s <- scan cs; return (c:s)+ scan (c:cs) | p c = do _ <- get; s <- scan cs; return (c:s) scan _ = do return "" munch1 :: (Char -> Bool) -> ReadP String -- ^ Parses the first one or more characters satisfying the predicate.+-- Fails if none, else succeeds exactly once having consumed all the characters+-- Hence NOT the same as (many1 (satisfy p)) munch1 p = do c <- get if p c then do s <- munch p; return (c:s) else pfail@@ -310,7 +321,7 @@ do s <- look skip s where- skip (c:s) | isSpace c = do get; skip s+ skip (c:s) | isSpace c = do _ <- get; skip s skip _ = do return () count :: Int -> ReadP a -> ReadP [a]@@ -321,9 +332,9 @@ between :: ReadP open -> ReadP close -> ReadP a -> ReadP a -- ^ @between open close p@ parses @open@, followed by @p@ and finally -- @close@. Only the value of @p@ is returned.-between open close p = do open+between open close p = do _ <- open x <- p- close+ _ <- close return x option :: a -> ReadP a -> ReadP a@@ -364,12 +375,12 @@ endBy :: ReadP a -> ReadP sep -> ReadP [a] -- ^ @endBy p sep@ parses zero or more occurrences of @p@, separated and ended -- by @sep@.-endBy p sep = many (do x <- p ; sep ; return x)+endBy p sep = many (do x <- p ; _ <- sep ; return x) endBy1 :: ReadP a -> ReadP sep -> ReadP [a] -- ^ @endBy p sep@ parses one or more occurrences of @p@, separated and ended -- by @sep@.-endBy1 p sep = many1 (do x <- p ; sep ; return x)+endBy1 p sep = many1 (do x <- p ; _ <- sep ; return x) chainr :: ReadP a -> ReadP (a -> a -> a) -> a -> ReadP a -- ^ @chainr p op x@ parses zero or more occurrences of @p@, separated by @op@.
Text/Printf.hs view
@@ -12,6 +12,8 @@ -- ----------------------------------------------------------------------------- +{-# Language CPP #-}+ module Text.Printf( printf, hPrintf, PrintfType, HPrintfType, PrintfArg, IsChar@@ -215,12 +217,12 @@ u:us'' -> (case c of 'c' -> adjust ("", [toEnum (toint u)])- 'd' -> adjust' (fmti u)- 'i' -> adjust' (fmti u)- 'x' -> adjust ("", fmtu 16 u)- 'X' -> adjust ("", map toUpper $ fmtu 16 u)- 'o' -> adjust ("", fmtu 8 u)- 'u' -> adjust ("", fmtu 10 u)+ 'd' -> adjust' (fmti prec u)+ 'i' -> adjust' (fmti prec u)+ 'x' -> adjust ("", fmtu 16 prec u)+ 'X' -> adjust ("", map toUpper $ fmtu 16 prec u)+ 'o' -> adjust ("", fmtu 8 prec u)+ 'u' -> adjust ("", fmtu 10 prec u) 'e' -> adjust' (dfmt' c prec u) 'E' -> adjust' (dfmt' c prec u) 'f' -> adjust' (dfmt' c prec u)@@ -230,15 +232,18 @@ _ -> perror ("bad formatting char " ++ [c]) ) ++ uprintf cs'' us'' -fmti :: UPrintf -> (String, String)-fmti (UInteger _ i) = if i < 0 then ("-", show (-i)) else ("", show i)-fmti (UChar c) = fmti (uInteger (fromEnum c))-fmti _ = baderr+fmti :: Int -> UPrintf -> (String, String)+fmti prec (UInteger _ i) = if i < 0 then ("-", integral_prec prec (show (-i))) else ("", integral_prec prec (show i))+fmti _ (UChar c) = fmti 0 (uInteger (fromEnum c))+fmti _ _ = baderr -fmtu :: Integer -> UPrintf -> String-fmtu b (UInteger l i) = itosb b (if i < 0 then -2*l + i else i)-fmtu b (UChar c) = itosb b (toInteger (fromEnum c))-fmtu _ _ = baderr+fmtu :: Integer -> Int -> UPrintf -> String+fmtu b prec (UInteger l i) = integral_prec prec (itosb b (if i < 0 then -2*l + i else i))+fmtu b _ (UChar c) = itosb b (toInteger (fromEnum c))+fmtu _ _ _ = baderr++integral_prec :: Int -> String -> String+integral_prec prec integral = (replicate (prec - (length integral)) '0') ++ integral toint :: UPrintf -> Int toint (UInteger _ i) = fromInteger i
Text/Read/Lex.hs view
@@ -151,10 +151,10 @@ lexLitChar :: ReadP Lexeme lexLitChar =- do char '\''+ do _ <- char '\'' (c,esc) <- lexCharE guard (esc || c /= '\'') -- Eliminate '' possibility- char '\''+ _ <- char '\'' return (Char c) lexChar :: ReadP Char@@ -195,7 +195,7 @@ return (chr (fromInteger n)) lexCntrlChar =- do char '^'+ do _ <- char '^' c <- get case c of '@' -> return '\^@'@@ -279,7 +279,7 @@ lexString :: ReadP Lexeme lexString =- do char '"'+ do _ <- char '"' body id where body f =@@ -293,11 +293,11 @@ +++ lexCharE lexEmpty =- do char '\\'+ do _ <- char '\\' c <- get case c of '&' -> do return ()- _ | isSpace c -> do skipSpaces; char '\\'; return ()+ _ | isSpace c -> do skipSpaces; _ <- char '\\'; return () _ -> do pfail -- ---------------------------------------------------------------------------@@ -314,7 +314,7 @@ lexHexOct :: ReadP Lexeme lexHexOct- = do char '0'+ = do _ <- char '0' base <- lexBaseChar digits <- lexDigits base return (Int (val (fromIntegral base) 0 digits))@@ -359,12 +359,12 @@ lexFrac :: ReadP (Maybe Digits) -- Read the fractional part; fail if it doesn't -- start ".d" where d is a digit-lexFrac = do char '.'+lexFrac = do _ <- char '.' fraction <- lexDigits 10 return (Just fraction) lexExp :: ReadP (Maybe Integer)-lexExp = do char 'e' +++ char 'E'+lexExp = do _ <- char 'e' +++ char 'E' exp <- signedExp +++ lexInteger 10 return (Just exp) where@@ -382,7 +382,7 @@ return xs where scan (c:cs) f = case valDig base c of- Just n -> do get; scan cs (f.(n:))+ Just n -> do _ <- get; scan cs (f.(n:)) Nothing -> do return (f []) scan [] f = do return (f [])
aclocal.m4 view
@@ -135,15 +135,17 @@ # include <sys/resource.h> #endif +#include <stdlib.h>+ typedef $1 testing; -main() {+int main(void) { FILE *f=fopen("conftestval", "w"); if (!f) exit(1); if (((testing)((int)((testing)1.4))) == ((testing)1.4)) { fprintf(f, "%s%d\n", ((testing)(-1) < (testing)0) ? "Int" : "Word",- sizeof(testing)*8);+ (int)(sizeof(testing)*8)); } else { fprintf(f,"%s\n", (sizeof(testing) > sizeof(double)) ? "LDouble" :@@ -167,60 +169,37 @@ ]) -# FP_READDIR_EOF_ERRNO-# ---------------------# Defines READDIR_ERRNO_EOF to what readdir() sets 'errno' to upon reaching end-# of directory (not set => 0); not setting it is the correct thing to do, but-# MinGW based versions have set it to ENOENT until recently (summer 2004).-AC_DEFUN([FP_READDIR_EOF_ERRNO],-[AC_CACHE_CHECK([what readdir sets errno to upon EOF], [fptools_cv_readdir_eof_errno],-[AC_RUN_IFELSE([AC_LANG_SOURCE([[#include <dirent.h>-#include <stdio.h>-#include <errno.h>-int-main(argc, argv)-int argc;-char **argv;-{- FILE *f=fopen("conftestval", "w");-#if defined(__MINGW32__)- int fd = mkdir("testdir");-#else- int fd = mkdir("testdir", 0666);-#endif- DIR* dp;- struct dirent* de;- int err = 0;-- if (!f) return 1;- if (fd == -1) { - fprintf(stderr,"unable to create directory; quitting.\n");- return 1;- }- close(fd);- dp = opendir("testdir");- if (!dp) { - fprintf(stderr,"unable to browse directory; quitting.\n");- rmdir("testdir");- return 1;- }-- /* the assumption here is that readdir() will only return NULL- * due to reaching the end of the directory.- */- while (de = readdir(dp)) {- ;- }- err = errno;- fprintf(f,"%d", err);- fclose(f);- closedir(dp);- rmdir("testdir");- return 0;-}]])],-[fptools_cv_readdir_eof_errno=`cat conftestval`],-[AC_MSG_WARN([failed to determine the errno value])- fptools_cv_readdir_eof_errno=0],-[fptools_cv_readdir_eof_errno=0])])-AC_DEFINE_UNQUOTED([READDIR_ERRNO_EOF], [$fptools_cv_readdir_eof_errno], [readdir() sets errno to this upon EOF])-])# FP_READDIR_EOF_ERRNO+# FP_SEARCH_LIBS_PROTO(WHAT, PROTOTYPE, FUNCTION, SEARCH-LIBS,+# [ACTION-IF-FOUND], [ACTION-IF-NOT-FOUND],+# [OTHER-LIBRARIES])+# --------------------------------------------------------+# Search for a library defining FUNC, if it's not already available.+# This is a copy of the AC_SEARCH_LIBS definition, but extended to take+# the name of the thing we are looking for as its first argument, and+# prototype text as its second argument. It also calls AC_LANG_PROGRAM+# instead of AC_LANG_CALL+AC_DEFUN([FP_SEARCH_LIBS_PROTO],+[AS_VAR_PUSHDEF([ac_Search], [ac_cv_search_$3])dnl+AC_CACHE_CHECK([for library containing $1], [ac_Search],+[ac_func_search_save_LIBS=$LIBS+AC_LANG_CONFTEST([AC_LANG_PROGRAM([$2], [$3])])+for ac_lib in '' $4; do+ if test -z "$ac_lib"; then+ ac_res="none required"+ else+ ac_res=-l$ac_lib+ LIBS="-l$ac_lib $7 $ac_func_search_save_LIBS"+ fi+ AC_LINK_IFELSE([], [AS_VAR_SET([ac_Search], [$ac_res])])+ AS_VAR_SET_IF([ac_Search], [break])+done+AS_VAR_SET_IF([ac_Search], , [AS_VAR_SET([ac_Search], [no])])+rm conftest.$ac_ext+LIBS=$ac_func_search_save_LIBS])+ac_res=AS_VAR_GET([ac_Search])+AS_IF([test "$ac_res" != no],+ [test "$ac_res" = "none required" || LIBS="$ac_res $LIBS"+ $5],+ [$6])dnl+AS_VAR_POPDEF([ac_Search])dnl+])
base.cabal view
@@ -1,14 +1,15 @@ name: base-version: 4.1.0.0+version: 4.2.0.0 license: BSD3 license-file: LICENSE maintainer: libraries@haskell.org+bug-reports: http://hackage.haskell.org/trac/ghc/newticket?component=libraries/base synopsis: Basic libraries description: This package contains the Prelude and its support libraries, and a large collection of useful libraries ranging from data structures to parsing combinators and debugging utilities.-cabal-version: >=1.2+cabal-version: >=1.6 build-type: Configure extra-tmp-files: config.log config.status autom4te.cache@@ -18,9 +19,21 @@ aclocal.m4 configure.ac configure include/CTypes.h +source-repository head+ type: darcs+ location: http://darcs.haskell.org/packages/base/++Flag integer-simple+ Description: Use integer-simple+ Library { if impl(ghc) {- build-depends: rts, ghc-prim, integer+ if flag(integer-simple)+ build-depends: integer-simple+ else+ build-depends: integer-gmp+ cpp-options: -DOPTIMISE_INTEGER_GCD_LCM+ build-depends: rts, ghc-prim exposed-modules: Foreign.Concurrent, GHC.Arr,@@ -28,6 +41,7 @@ GHC.Classes, GHC.Conc, GHC.ConsoleHandler,+ GHC.Constants, GHC.Desugar, GHC.Enum, GHC.Environment,@@ -36,9 +50,31 @@ GHC.Exts, GHC.Float, GHC.ForeignPtr,- GHC.Handle,+ GHC.MVar, GHC.IO,+ GHC.IO.IOMode,+ GHC.IO.Buffer,+ GHC.IO.Device,+ GHC.IO.BufferedIO,+ GHC.IO.FD,+ GHC.IO.Exception,+ GHC.IO.Encoding,+ GHC.IO.Encoding.Latin1,+ GHC.IO.Encoding.UTF8,+ GHC.IO.Encoding.UTF16,+ GHC.IO.Encoding.UTF32,+ GHC.IO.Encoding.Types,+ GHC.IO.Encoding.Iconv,+ GHC.IO.Encoding.CodePage,+ GHC.IO.Handle,+ GHC.IO.Handle.Types,+ GHC.IO.Handle.Internals,+ GHC.IO.Handle.FD,+ GHC.IO.Handle.Text, GHC.IOBase,+ GHC.Handle,+ GHC.IORef,+ GHC.IOArray, GHC.Int, GHC.List, GHC.Num,@@ -57,12 +93,14 @@ GHC.Weak, GHC.Word, System.Timeout+ if os(windows)+ exposed-modules: GHC.IO.Encoding.CodePage.Table extensions: MagicHash, ExistentialQuantification, Rank2Types, ScopedTypeVariables, UnboxedTuples, ForeignFunctionInterface, UnliftedFFITypes, DeriveDataTypeable, GeneralizedNewtypeDeriving, FlexibleInstances, StandaloneDeriving,- PatternGuards, EmptyDataDecls+ PatternGuards, EmptyDataDecls, NoImplicitPrelude if impl(ghc < 6.10) -- PatternSignatures was deprecated in 6.10@@ -98,6 +136,7 @@ Data.Fixed, Data.Foldable Data.Function,+ Data.Functor, Data.HashTable, Data.IORef, Data.Int,@@ -161,14 +200,15 @@ cbits/WCsubst.c cbits/Win32Utils.c cbits/consUtils.c- cbits/dirUtils.c+ cbits/iconv.c cbits/inputReady.c cbits/selectUtils.c+ cbits/primFloat.c include-dirs: include includes: HsBase.h- install-includes: HsBase.h HsBaseConfig.h WCsubst.h dirUtils.h consUtils.h Typeable.h+ install-includes: HsBase.h HsBaseConfig.h WCsubst.h consUtils.h Typeable.h if os(windows) {- extra-libraries: wsock32, msvcrt, kernel32, user32, shell32+ extra-libraries: wsock32, user32, shell32 } extensions: CPP -- We need to set the package name to base (without a version number)
cbits/PrelIOUtils.c view
@@ -13,7 +13,6 @@ #include "HsBase.h" #ifdef __GLASGOW_HASKELL__-# include "RtsMessages.h" void errorBelch2(const char*s, char *t) {@@ -24,4 +23,14 @@ { debugBelch(s,t); }++// Use a C wrapper for this because we avoid hsc2hs in base+#if HAVE_LANGINFO_H+#include <langinfo.h>+char *localeEncoding (void)+{+ return nl_langinfo(CODESET);+}+#endif+ #endif /* __GLASGOW_HASKELL__ */
− cbits/dirUtils.c
@@ -1,72 +0,0 @@-/* - * (c) The University of Glasgow 2002- *- * Directory Runtime Support- */--/* needed only for solaris2_HOST_OS */-#include "ghcconfig.h"--// The following is required on Solaris to force the POSIX versions of-// the various _r functions instead of the Solaris versions.-#ifdef solaris2_HOST_OS-#define _POSIX_PTHREAD_SEMANTICS-#endif--#include "HsBase.h"--#if defined(_MSC_VER) || defined(__MINGW32__) || defined(_WIN32)-#include <windows.h>-#endif---/*- * read an entry from the directory stream; opt for the- * re-entrant friendly way of doing this, if available.- */-int-__hscore_readdir( DIR *dirPtr, struct dirent **pDirEnt )-{-#if HAVE_READDIR_R- struct dirent* p;- int res;- static unsigned int nm_max = (unsigned int)-1;- - if (pDirEnt == NULL) {- return -1;- }- if (nm_max == (unsigned int)-1) {-#ifdef NAME_MAX- nm_max = NAME_MAX + 1;-#else- nm_max = pathconf(".", _PC_NAME_MAX);- if (nm_max == -1) { nm_max = 255; }- nm_max++;-#endif- }- p = (struct dirent*)malloc(sizeof(struct dirent) + nm_max);- if (p == NULL) return -1;- res = readdir_r(dirPtr, p, pDirEnt);- if (res != 0) {- *pDirEnt = NULL;- free(p);- }- else if (*pDirEnt == NULL) {- // end of stream- free(p);- }- return res;-#else-- if (pDirEnt == NULL) {- return -1;- }-- *pDirEnt = readdir(dirPtr);- if (*pDirEnt == NULL) {- return -1;- } else {- return 0;- } -#endif-}
+ cbits/iconv.c view
@@ -0,0 +1,25 @@+#ifndef __MINGW32__++#include <stdlib.h>+#include <iconv.h>++iconv_t hs_iconv_open(const char* tocode,+ const char* fromcode)+{+ return iconv_open(tocode, fromcode);+}++size_t hs_iconv(iconv_t cd,+ const char* * inbuf, size_t * inbytesleft,+ char* * outbuf, size_t * outbytesleft)+{+ // (void*) cast avoids a warning. Some iconvs use (const+ // char**inbuf), other use (char **inbuf).+ return iconv(cd, (void*)inbuf, inbytesleft, outbuf, outbytesleft);+}++int hs_iconv_close(iconv_t cd) {+ return iconv_close(cd);+}++#endif
+ cbits/primFloat.c view
@@ -0,0 +1,261 @@+/* -----------------------------------------------------------------------------+ *+ * (c) Lennart Augustsson+ * (c) The GHC Team, 1998-2000+ *+ * Miscellaneous support for floating-point primitives+ *+ * ---------------------------------------------------------------------------*/++#include "HsFFI.h"+#include "Rts.h" // XXX wrong (for IEEE_FLOATING_POINT and WORDS_BIGENDIAN)++#define IEEE_FLOATING_POINT 1++union stg_ieee754_flt+{+ float f;+ struct {++#if WORDS_BIGENDIAN+ unsigned int negative:1;+ unsigned int exponent:8;+ unsigned int mantissa:23;+#else+ unsigned int mantissa:23;+ unsigned int exponent:8;+ unsigned int negative:1;+#endif+ } ieee;+ struct {++#if WORDS_BIGENDIAN+ unsigned int negative:1;+ unsigned int exponent:8;+ unsigned int quiet_nan:1;+ unsigned int mantissa:22;+#else+ unsigned int mantissa:22;+ unsigned int quiet_nan:1;+ unsigned int exponent:8;+ unsigned int negative:1;+#endif+ } ieee_nan;+};++/*+ + To recap, here's the representation of a double precision+ IEEE floating point number:++ sign 63 sign bit (0==positive, 1==negative)+ exponent 62-52 exponent (biased by 1023)+ fraction 51-0 fraction (bits to right of binary point)+*/++union stg_ieee754_dbl+{+ double d;+ struct {++#if WORDS_BIGENDIAN+ unsigned int negative:1;+ unsigned int exponent:11;+ unsigned int mantissa0:20;+ unsigned int mantissa1:32;+#else+#if FLOAT_WORDS_BIGENDIAN+ unsigned int mantissa0:20;+ unsigned int exponent:11;+ unsigned int negative:1;+ unsigned int mantissa1:32;+#else+ unsigned int mantissa1:32;+ unsigned int mantissa0:20;+ unsigned int exponent:11;+ unsigned int negative:1;+#endif+#endif+ } ieee;+ /* This format makes it easier to see if a NaN is a signalling NaN. */+ struct {++#if WORDS_BIGENDIAN+ unsigned int negative:1;+ unsigned int exponent:11;+ unsigned int quiet_nan:1;+ unsigned int mantissa0:19;+ unsigned int mantissa1:32;+#else+#if FLOAT_WORDS_BIGENDIAN+ unsigned int mantissa0:19;+ unsigned int quiet_nan:1;+ unsigned int exponent:11;+ unsigned int negative:1;+ unsigned int mantissa1:32;+#else+ unsigned int mantissa1:32;+ unsigned int mantissa0:19;+ unsigned int quiet_nan:1;+ unsigned int exponent:11;+ unsigned int negative:1;+#endif+#endif+ } ieee_nan;+};++/*+ * Predicates for testing for extreme IEEE fp values.+ */ ++/* In case you don't suppport IEEE, you'll just get dummy defs.. */+#ifdef IEEE_FLOATING_POINT++HsInt+isDoubleNaN(HsDouble d)+{+ union stg_ieee754_dbl u;+ + u.d = d;++ return (+ u.ieee.exponent == 2047 /* 2^11 - 1 */ && /* Is the exponent all ones? */+ (u.ieee.mantissa0 != 0 || u.ieee.mantissa1 != 0)+ /* and the mantissa non-zero? */+ );+}++HsInt+isDoubleInfinite(HsDouble d)+{+ union stg_ieee754_dbl u;++ u.d = d;++ /* Inf iff exponent is all ones, mantissa all zeros */+ return (+ u.ieee.exponent == 2047 /* 2^11 - 1 */ &&+ u.ieee.mantissa0 == 0 &&+ u.ieee.mantissa1 == 0+ );+}++HsInt+isDoubleDenormalized(HsDouble d) +{+ union stg_ieee754_dbl u;++ u.d = d;++ /* A (single/double/quad) precision floating point number+ is denormalised iff:+ - exponent is zero+ - mantissa is non-zero.+ - (don't care about setting of sign bit.)++ */+ return ( + u.ieee.exponent == 0 &&+ (u.ieee.mantissa0 != 0 ||+ u.ieee.mantissa1 != 0)+ );+ +}++HsInt+isDoubleNegativeZero(HsDouble d) +{+ union stg_ieee754_dbl u;++ u.d = d;+ /* sign (bit 63) set (only) => negative zero */++ return (+ u.ieee.negative == 1 &&+ u.ieee.exponent == 0 &&+ u.ieee.mantissa0 == 0 &&+ u.ieee.mantissa1 == 0);+}++/* Same tests, this time for HsFloats. */++/*+ To recap, here's the representation of a single precision+ IEEE floating point number:++ sign 31 sign bit (0 == positive, 1 == negative)+ exponent 30-23 exponent (biased by 127)+ fraction 22-0 fraction (bits to right of binary point)+*/+++HsInt+isFloatNaN(HsFloat f)+{+ union stg_ieee754_flt u;+ u.f = f;++ /* Floating point NaN iff exponent is all ones, mantissa is+ non-zero (but see below.) */+ return (+ u.ieee.exponent == 255 /* 2^8 - 1 */ &&+ u.ieee.mantissa != 0);+}++HsInt+isFloatInfinite(HsFloat f)+{+ union stg_ieee754_flt u;+ u.f = f;+ + /* A float is Inf iff exponent is max (all ones),+ and mantissa is min(all zeros.) */+ return (+ u.ieee.exponent == 255 /* 2^8 - 1 */ &&+ u.ieee.mantissa == 0);+}++HsInt+isFloatDenormalized(HsFloat f)+{+ union stg_ieee754_flt u;+ u.f = f;++ /* A (single/double/quad) precision floating point number+ is denormalised iff:+ - exponent is zero+ - mantissa is non-zero.+ - (don't care about setting of sign bit.)++ */+ return (+ u.ieee.exponent == 0 &&+ u.ieee.mantissa != 0);+}++HsInt+isFloatNegativeZero(HsFloat f) +{+ union stg_ieee754_flt u;+ u.f = f;++ /* sign (bit 31) set (only) => negative zero */+ return (+ u.ieee.negative &&+ u.ieee.exponent == 0 &&+ u.ieee.mantissa == 0);+}++#else /* ! IEEE_FLOATING_POINT */++/* Dummy definitions of predicates - they all return false */+HsInt isDoubleNaN(d) HsDouble d; { return 0; }+HsInt isDoubleInfinite(d) HsDouble d; { return 0; }+HsInt isDoubleDenormalized(d) HsDouble d; { return 0; }+HsInt isDoubleNegativeZero(d) HsDouble d; { return 0; }+HsInt isFloatNaN(f) HsFloat f; { return 0; }+HsInt isFloatInfinite(f) HsFloat f; { return 0; }+HsInt isFloatDenormalized(f) HsFloat f; { return 0; }+HsInt isFloatNegativeZero(f) HsFloat f; { return 0; }++#endif /* ! IEEE_FLOATING_POINT */
configure view
@@ -662,6 +662,9 @@ CPP GREP EGREP+ICONV_INCLUDE_DIRS+ICONV_LIB_DIRS+EXTRA_LIBS LIBOBJS LTLIBOBJS' ac_subst_files=''@@ -1250,6 +1253,8 @@ --with-PACKAGE[=ARG] use PACKAGE [ARG=yes] --without-PACKAGE do not use PACKAGE (same as --with-PACKAGE=no) C compiler+ --with-iconv-includes directory containing iconv.h+ --with-iconv-libraries directory containing iconv library Some influential environment variables: CC C compiler command@@ -3326,113 +3331,6 @@ fi -{ echo "$as_me:$LINENO: checking for an ANSI C-conforming const" >&5-echo $ECHO_N "checking for an ANSI C-conforming const... $ECHO_C" >&6; }-if test "${ac_cv_c_const+set}" = set; then- echo $ECHO_N "(cached) $ECHO_C" >&6-else- cat >conftest.$ac_ext <<_ACEOF-/* confdefs.h. */-_ACEOF-cat confdefs.h >>conftest.$ac_ext-cat >>conftest.$ac_ext <<_ACEOF-/* end confdefs.h. */--int-main ()-{-/* FIXME: Include the comments suggested by Paul. */-#ifndef __cplusplus- /* Ultrix mips cc rejects this. */- typedef int charset[2];- const charset cs;- /* SunOS 4.1.1 cc rejects this. */- char const *const *pcpcc;- char **ppc;- /* NEC SVR4.0.2 mips cc rejects this. */- struct point {int x, y;};- static struct point const zero = {0,0};- /* AIX XL C 1.02.0.0 rejects this.- It does not let you subtract one const X* pointer from another in- an arm of an if-expression whose if-part is not a constant- expression */- const char *g = "string";- pcpcc = &g + (g ? g-g : 0);- /* HPUX 7.0 cc rejects these. */- ++pcpcc;- ppc = (char**) pcpcc;- pcpcc = (char const *const *) ppc;- { /* SCO 3.2v4 cc rejects this. */- char *t;- char const *s = 0 ? (char *) 0 : (char const *) 0;-- *t++ = 0;- if (s) return 0;- }- { /* Someone thinks the Sun supposedly-ANSI compiler will reject this. */- int x[] = {25, 17};- const int *foo = &x[0];- ++foo;- }- { /* Sun SC1.0 ANSI compiler rejects this -- but not the above. */- typedef const int *iptr;- iptr p = 0;- ++p;- }- { /* AIX XL C 1.02.0.0 rejects this saying- "k.c", line 2.27: 1506-025 (S) Operand must be a modifiable lvalue. */- struct s { int j; const int *ap[3]; };- struct s *b; b->j = 5;- }- { /* ULTRIX-32 V3.1 (Rev 9) vcc rejects this */- const int foo = 10;- if (!foo) return 0;- }- return !cs[0] && !zero.x;-#endif-- ;- return 0;-}-_ACEOF-rm -f conftest.$ac_objext-if { (ac_try="$ac_compile"-case "(($ac_try" in- *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;- *) ac_try_echo=$ac_try;;-esac-eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5- (eval "$ac_compile") 2>conftest.er1- ac_status=$?- grep -v '^ *+' conftest.er1 >conftest.err- rm -f conftest.er1- cat conftest.err >&5- echo "$as_me:$LINENO: \$? = $ac_status" >&5- (exit $ac_status); } && {- test -z "$ac_c_werror_flag" ||- test ! -s conftest.err- } && test -s conftest.$ac_objext; then- ac_cv_c_const=yes-else- echo "$as_me: failed program was:" >&5-sed 's/^/| /' conftest.$ac_ext >&5-- ac_cv_c_const=no-fi--rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext-fi-{ echo "$as_me:$LINENO: result: $ac_cv_c_const" >&5-echo "${ECHO_T}$ac_cv_c_const" >&6; }-if test $ac_cv_c_const = no; then--cat >>confdefs.h <<\_ACEOF-#define const-_ACEOF--fi-- { echo "$as_me:$LINENO: checking for ANSI C header files" >&5 echo $ECHO_N "checking for ANSI C header files... $ECHO_C" >&6; } if test "${ac_cv_header_stdc+set}" = set; then@@ -3633,7 +3531,7 @@ -for ac_header in ctype.h dirent.h errno.h fcntl.h inttypes.h limits.h signal.h sys/resource.h sys/select.h sys/stat.h sys/syscall.h sys/time.h sys/timeb.h sys/timers.h sys/times.h sys/types.h sys/utsname.h sys/wait.h termios.h time.h unistd.h utime.h windows.h winsock.h+for ac_header in ctype.h errno.h fcntl.h inttypes.h limits.h signal.h sys/resource.h sys/select.h sys/stat.h sys/syscall.h sys/time.h sys/timeb.h sys/timers.h sys/times.h sys/types.h sys/utsname.h sys/wait.h termios.h time.h unistd.h utime.h windows.h winsock.h langinfo.h do as_ac_Header=`echo "ac_cv_header_$ac_header" | $as_tr_sh` if { as_var=$as_ac_Header; eval "test \"\${$as_var+set}\" = set"; }; then@@ -4371,8 +4269,7 @@ --for ac_func in lstat readdir_r+for ac_func in lstat do as_ac_var=`echo "ac_cv_func_$ac_func" | $as_tr_sh` { echo "$as_me:$LINENO: checking for $ac_func" >&5@@ -4657,6 +4554,28 @@ done +++# Check whether --with-iconv-includes was given.+if test "${with_iconv_includes+set}" = set; then+ withval=$with_iconv_includes; ICONV_INCLUDE_DIRS=$withval; CPPFLAGS="-I$withval"+else+ ICONV_INCLUDE_DIRS=+fi++++# Check whether --with-iconv-libraries was given.+if test "${with_iconv_libraries+set}" = set; then+ withval=$with_iconv_libraries; ICONV_LIB_DIRS=$withval; LDFLAGS="-L$withval"+else+ ICONV_LIB_DIRS=+fi+++++ # map standard C types and ISO types to Haskell types { echo "$as_me:$LINENO: checking Haskell type for char" >&5 echo $ECHO_N "checking Haskell type for char... $ECHO_C" >&6; }@@ -4744,15 +4663,17 @@ # include <sys/resource.h> #endif +#include <stdlib.h>+ typedef char testing; -main() {+int main(void) { FILE *f=fopen("conftestval", "w"); if (!f) exit(1); if (((testing)((int)((testing)1.4))) == ((testing)1.4)) { fprintf(f, "%s%d\n", ((testing)(-1) < (testing)0) ? "Int" : "Word",- sizeof(testing)*8);+ (int)(sizeof(testing)*8)); } else { fprintf(f,"%s\n", (sizeof(testing) > sizeof(double)) ? "LDouble" :@@ -4896,15 +4817,17 @@ # include <sys/resource.h> #endif +#include <stdlib.h>+ typedef signed char testing; -main() {+int main(void) { FILE *f=fopen("conftestval", "w"); if (!f) exit(1); if (((testing)((int)((testing)1.4))) == ((testing)1.4)) { fprintf(f, "%s%d\n", ((testing)(-1) < (testing)0) ? "Int" : "Word",- sizeof(testing)*8);+ (int)(sizeof(testing)*8)); } else { fprintf(f,"%s\n", (sizeof(testing) > sizeof(double)) ? "LDouble" :@@ -5048,15 +4971,17 @@ # include <sys/resource.h> #endif +#include <stdlib.h>+ typedef unsigned char testing; -main() {+int main(void) { FILE *f=fopen("conftestval", "w"); if (!f) exit(1); if (((testing)((int)((testing)1.4))) == ((testing)1.4)) { fprintf(f, "%s%d\n", ((testing)(-1) < (testing)0) ? "Int" : "Word",- sizeof(testing)*8);+ (int)(sizeof(testing)*8)); } else { fprintf(f,"%s\n", (sizeof(testing) > sizeof(double)) ? "LDouble" :@@ -5200,15 +5125,17 @@ # include <sys/resource.h> #endif +#include <stdlib.h>+ typedef short testing; -main() {+int main(void) { FILE *f=fopen("conftestval", "w"); if (!f) exit(1); if (((testing)((int)((testing)1.4))) == ((testing)1.4)) { fprintf(f, "%s%d\n", ((testing)(-1) < (testing)0) ? "Int" : "Word",- sizeof(testing)*8);+ (int)(sizeof(testing)*8)); } else { fprintf(f,"%s\n", (sizeof(testing) > sizeof(double)) ? "LDouble" :@@ -5352,15 +5279,17 @@ # include <sys/resource.h> #endif +#include <stdlib.h>+ typedef unsigned short testing; -main() {+int main(void) { FILE *f=fopen("conftestval", "w"); if (!f) exit(1); if (((testing)((int)((testing)1.4))) == ((testing)1.4)) { fprintf(f, "%s%d\n", ((testing)(-1) < (testing)0) ? "Int" : "Word",- sizeof(testing)*8);+ (int)(sizeof(testing)*8)); } else { fprintf(f,"%s\n", (sizeof(testing) > sizeof(double)) ? "LDouble" :@@ -5504,15 +5433,17 @@ # include <sys/resource.h> #endif +#include <stdlib.h>+ typedef int testing; -main() {+int main(void) { FILE *f=fopen("conftestval", "w"); if (!f) exit(1); if (((testing)((int)((testing)1.4))) == ((testing)1.4)) { fprintf(f, "%s%d\n", ((testing)(-1) < (testing)0) ? "Int" : "Word",- sizeof(testing)*8);+ (int)(sizeof(testing)*8)); } else { fprintf(f,"%s\n", (sizeof(testing) > sizeof(double)) ? "LDouble" :@@ -5656,15 +5587,17 @@ # include <sys/resource.h> #endif +#include <stdlib.h>+ typedef unsigned int testing; -main() {+int main(void) { FILE *f=fopen("conftestval", "w"); if (!f) exit(1); if (((testing)((int)((testing)1.4))) == ((testing)1.4)) { fprintf(f, "%s%d\n", ((testing)(-1) < (testing)0) ? "Int" : "Word",- sizeof(testing)*8);+ (int)(sizeof(testing)*8)); } else { fprintf(f,"%s\n", (sizeof(testing) > sizeof(double)) ? "LDouble" :@@ -5808,15 +5741,17 @@ # include <sys/resource.h> #endif +#include <stdlib.h>+ typedef long testing; -main() {+int main(void) { FILE *f=fopen("conftestval", "w"); if (!f) exit(1); if (((testing)((int)((testing)1.4))) == ((testing)1.4)) { fprintf(f, "%s%d\n", ((testing)(-1) < (testing)0) ? "Int" : "Word",- sizeof(testing)*8);+ (int)(sizeof(testing)*8)); } else { fprintf(f,"%s\n", (sizeof(testing) > sizeof(double)) ? "LDouble" :@@ -5960,15 +5895,17 @@ # include <sys/resource.h> #endif +#include <stdlib.h>+ typedef unsigned long testing; -main() {+int main(void) { FILE *f=fopen("conftestval", "w"); if (!f) exit(1); if (((testing)((int)((testing)1.4))) == ((testing)1.4)) { fprintf(f, "%s%d\n", ((testing)(-1) < (testing)0) ? "Int" : "Word",- sizeof(testing)*8);+ (int)(sizeof(testing)*8)); } else { fprintf(f,"%s\n", (sizeof(testing) > sizeof(double)) ? "LDouble" :@@ -6113,15 +6050,17 @@ # include <sys/resource.h> #endif +#include <stdlib.h>+ typedef long long testing; -main() {+int main(void) { FILE *f=fopen("conftestval", "w"); if (!f) exit(1); if (((testing)((int)((testing)1.4))) == ((testing)1.4)) { fprintf(f, "%s%d\n", ((testing)(-1) < (testing)0) ? "Int" : "Word",- sizeof(testing)*8);+ (int)(sizeof(testing)*8)); } else { fprintf(f,"%s\n", (sizeof(testing) > sizeof(double)) ? "LDouble" :@@ -6265,15 +6204,17 @@ # include <sys/resource.h> #endif +#include <stdlib.h>+ typedef unsigned long long testing; -main() {+int main(void) { FILE *f=fopen("conftestval", "w"); if (!f) exit(1); if (((testing)((int)((testing)1.4))) == ((testing)1.4)) { fprintf(f, "%s%d\n", ((testing)(-1) < (testing)0) ? "Int" : "Word",- sizeof(testing)*8);+ (int)(sizeof(testing)*8)); } else { fprintf(f,"%s\n", (sizeof(testing) > sizeof(double)) ? "LDouble" :@@ -6418,15 +6359,17 @@ # include <sys/resource.h> #endif +#include <stdlib.h>+ typedef float testing; -main() {+int main(void) { FILE *f=fopen("conftestval", "w"); if (!f) exit(1); if (((testing)((int)((testing)1.4))) == ((testing)1.4)) { fprintf(f, "%s%d\n", ((testing)(-1) < (testing)0) ? "Int" : "Word",- sizeof(testing)*8);+ (int)(sizeof(testing)*8)); } else { fprintf(f,"%s\n", (sizeof(testing) > sizeof(double)) ? "LDouble" :@@ -6570,15 +6513,17 @@ # include <sys/resource.h> #endif +#include <stdlib.h>+ typedef double testing; -main() {+int main(void) { FILE *f=fopen("conftestval", "w"); if (!f) exit(1); if (((testing)((int)((testing)1.4))) == ((testing)1.4)) { fprintf(f, "%s%d\n", ((testing)(-1) < (testing)0) ? "Int" : "Word",- sizeof(testing)*8);+ (int)(sizeof(testing)*8)); } else { fprintf(f,"%s\n", (sizeof(testing) > sizeof(double)) ? "LDouble" :@@ -6722,15 +6667,17 @@ # include <sys/resource.h> #endif +#include <stdlib.h>+ typedef ptrdiff_t testing; -main() {+int main(void) { FILE *f=fopen("conftestval", "w"); if (!f) exit(1); if (((testing)((int)((testing)1.4))) == ((testing)1.4)) { fprintf(f, "%s%d\n", ((testing)(-1) < (testing)0) ? "Int" : "Word",- sizeof(testing)*8);+ (int)(sizeof(testing)*8)); } else { fprintf(f,"%s\n", (sizeof(testing) > sizeof(double)) ? "LDouble" :@@ -6874,15 +6821,17 @@ # include <sys/resource.h> #endif +#include <stdlib.h>+ typedef size_t testing; -main() {+int main(void) { FILE *f=fopen("conftestval", "w"); if (!f) exit(1); if (((testing)((int)((testing)1.4))) == ((testing)1.4)) { fprintf(f, "%s%d\n", ((testing)(-1) < (testing)0) ? "Int" : "Word",- sizeof(testing)*8);+ (int)(sizeof(testing)*8)); } else { fprintf(f,"%s\n", (sizeof(testing) > sizeof(double)) ? "LDouble" :@@ -7026,15 +6975,17 @@ # include <sys/resource.h> #endif +#include <stdlib.h>+ typedef wchar_t testing; -main() {+int main(void) { FILE *f=fopen("conftestval", "w"); if (!f) exit(1); if (((testing)((int)((testing)1.4))) == ((testing)1.4)) { fprintf(f, "%s%d\n", ((testing)(-1) < (testing)0) ? "Int" : "Word",- sizeof(testing)*8);+ (int)(sizeof(testing)*8)); } else { fprintf(f,"%s\n", (sizeof(testing) > sizeof(double)) ? "LDouble" :@@ -7179,15 +7130,17 @@ # include <sys/resource.h> #endif +#include <stdlib.h>+ typedef sig_atomic_t testing; -main() {+int main(void) { FILE *f=fopen("conftestval", "w"); if (!f) exit(1); if (((testing)((int)((testing)1.4))) == ((testing)1.4)) { fprintf(f, "%s%d\n", ((testing)(-1) < (testing)0) ? "Int" : "Word",- sizeof(testing)*8);+ (int)(sizeof(testing)*8)); } else { fprintf(f,"%s\n", (sizeof(testing) > sizeof(double)) ? "LDouble" :@@ -7331,15 +7284,17 @@ # include <sys/resource.h> #endif +#include <stdlib.h>+ typedef clock_t testing; -main() {+int main(void) { FILE *f=fopen("conftestval", "w"); if (!f) exit(1); if (((testing)((int)((testing)1.4))) == ((testing)1.4)) { fprintf(f, "%s%d\n", ((testing)(-1) < (testing)0) ? "Int" : "Word",- sizeof(testing)*8);+ (int)(sizeof(testing)*8)); } else { fprintf(f,"%s\n", (sizeof(testing) > sizeof(double)) ? "LDouble" :@@ -7483,15 +7438,17 @@ # include <sys/resource.h> #endif +#include <stdlib.h>+ typedef time_t testing; -main() {+int main(void) { FILE *f=fopen("conftestval", "w"); if (!f) exit(1); if (((testing)((int)((testing)1.4))) == ((testing)1.4)) { fprintf(f, "%s%d\n", ((testing)(-1) < (testing)0) ? "Int" : "Word",- sizeof(testing)*8);+ (int)(sizeof(testing)*8)); } else { fprintf(f,"%s\n", (sizeof(testing) > sizeof(double)) ? "LDouble" :@@ -7635,15 +7592,17 @@ # include <sys/resource.h> #endif +#include <stdlib.h>+ typedef dev_t testing; -main() {+int main(void) { FILE *f=fopen("conftestval", "w"); if (!f) exit(1); if (((testing)((int)((testing)1.4))) == ((testing)1.4)) { fprintf(f, "%s%d\n", ((testing)(-1) < (testing)0) ? "Int" : "Word",- sizeof(testing)*8);+ (int)(sizeof(testing)*8)); } else { fprintf(f,"%s\n", (sizeof(testing) > sizeof(double)) ? "LDouble" :@@ -7787,15 +7746,17 @@ # include <sys/resource.h> #endif +#include <stdlib.h>+ typedef ino_t testing; -main() {+int main(void) { FILE *f=fopen("conftestval", "w"); if (!f) exit(1); if (((testing)((int)((testing)1.4))) == ((testing)1.4)) { fprintf(f, "%s%d\n", ((testing)(-1) < (testing)0) ? "Int" : "Word",- sizeof(testing)*8);+ (int)(sizeof(testing)*8)); } else { fprintf(f,"%s\n", (sizeof(testing) > sizeof(double)) ? "LDouble" :@@ -7939,15 +7900,17 @@ # include <sys/resource.h> #endif +#include <stdlib.h>+ typedef mode_t testing; -main() {+int main(void) { FILE *f=fopen("conftestval", "w"); if (!f) exit(1); if (((testing)((int)((testing)1.4))) == ((testing)1.4)) { fprintf(f, "%s%d\n", ((testing)(-1) < (testing)0) ? "Int" : "Word",- sizeof(testing)*8);+ (int)(sizeof(testing)*8)); } else { fprintf(f,"%s\n", (sizeof(testing) > sizeof(double)) ? "LDouble" :@@ -8091,15 +8054,17 @@ # include <sys/resource.h> #endif +#include <stdlib.h>+ typedef off_t testing; -main() {+int main(void) { FILE *f=fopen("conftestval", "w"); if (!f) exit(1); if (((testing)((int)((testing)1.4))) == ((testing)1.4)) { fprintf(f, "%s%d\n", ((testing)(-1) < (testing)0) ? "Int" : "Word",- sizeof(testing)*8);+ (int)(sizeof(testing)*8)); } else { fprintf(f,"%s\n", (sizeof(testing) > sizeof(double)) ? "LDouble" :@@ -8243,15 +8208,17 @@ # include <sys/resource.h> #endif +#include <stdlib.h>+ typedef pid_t testing; -main() {+int main(void) { FILE *f=fopen("conftestval", "w"); if (!f) exit(1); if (((testing)((int)((testing)1.4))) == ((testing)1.4)) { fprintf(f, "%s%d\n", ((testing)(-1) < (testing)0) ? "Int" : "Word",- sizeof(testing)*8);+ (int)(sizeof(testing)*8)); } else { fprintf(f,"%s\n", (sizeof(testing) > sizeof(double)) ? "LDouble" :@@ -8395,15 +8362,17 @@ # include <sys/resource.h> #endif +#include <stdlib.h>+ typedef gid_t testing; -main() {+int main(void) { FILE *f=fopen("conftestval", "w"); if (!f) exit(1); if (((testing)((int)((testing)1.4))) == ((testing)1.4)) { fprintf(f, "%s%d\n", ((testing)(-1) < (testing)0) ? "Int" : "Word",- sizeof(testing)*8);+ (int)(sizeof(testing)*8)); } else { fprintf(f,"%s\n", (sizeof(testing) > sizeof(double)) ? "LDouble" :@@ -8547,15 +8516,17 @@ # include <sys/resource.h> #endif +#include <stdlib.h>+ typedef uid_t testing; -main() {+int main(void) { FILE *f=fopen("conftestval", "w"); if (!f) exit(1); if (((testing)((int)((testing)1.4))) == ((testing)1.4)) { fprintf(f, "%s%d\n", ((testing)(-1) < (testing)0) ? "Int" : "Word",- sizeof(testing)*8);+ (int)(sizeof(testing)*8)); } else { fprintf(f,"%s\n", (sizeof(testing) > sizeof(double)) ? "LDouble" :@@ -8699,15 +8670,17 @@ # include <sys/resource.h> #endif +#include <stdlib.h>+ typedef cc_t testing; -main() {+int main(void) { FILE *f=fopen("conftestval", "w"); if (!f) exit(1); if (((testing)((int)((testing)1.4))) == ((testing)1.4)) { fprintf(f, "%s%d\n", ((testing)(-1) < (testing)0) ? "Int" : "Word",- sizeof(testing)*8);+ (int)(sizeof(testing)*8)); } else { fprintf(f,"%s\n", (sizeof(testing) > sizeof(double)) ? "LDouble" :@@ -8851,15 +8824,17 @@ # include <sys/resource.h> #endif +#include <stdlib.h>+ typedef speed_t testing; -main() {+int main(void) { FILE *f=fopen("conftestval", "w"); if (!f) exit(1); if (((testing)((int)((testing)1.4))) == ((testing)1.4)) { fprintf(f, "%s%d\n", ((testing)(-1) < (testing)0) ? "Int" : "Word",- sizeof(testing)*8);+ (int)(sizeof(testing)*8)); } else { fprintf(f,"%s\n", (sizeof(testing) > sizeof(double)) ? "LDouble" :@@ -9003,15 +8978,17 @@ # include <sys/resource.h> #endif +#include <stdlib.h>+ typedef tcflag_t testing; -main() {+int main(void) { FILE *f=fopen("conftestval", "w"); if (!f) exit(1); if (((testing)((int)((testing)1.4))) == ((testing)1.4)) { fprintf(f, "%s%d\n", ((testing)(-1) < (testing)0) ? "Int" : "Word",- sizeof(testing)*8);+ (int)(sizeof(testing)*8)); } else { fprintf(f,"%s\n", (sizeof(testing) > sizeof(double)) ? "LDouble" :@@ -9155,15 +9132,17 @@ # include <sys/resource.h> #endif +#include <stdlib.h>+ typedef nlink_t testing; -main() {+int main(void) { FILE *f=fopen("conftestval", "w"); if (!f) exit(1); if (((testing)((int)((testing)1.4))) == ((testing)1.4)) { fprintf(f, "%s%d\n", ((testing)(-1) < (testing)0) ? "Int" : "Word",- sizeof(testing)*8);+ (int)(sizeof(testing)*8)); } else { fprintf(f,"%s\n", (sizeof(testing) > sizeof(double)) ? "LDouble" :@@ -9307,15 +9286,17 @@ # include <sys/resource.h> #endif +#include <stdlib.h>+ typedef ssize_t testing; -main() {+int main(void) { FILE *f=fopen("conftestval", "w"); if (!f) exit(1); if (((testing)((int)((testing)1.4))) == ((testing)1.4)) { fprintf(f, "%s%d\n", ((testing)(-1) < (testing)0) ? "Int" : "Word",- sizeof(testing)*8);+ (int)(sizeof(testing)*8)); } else { fprintf(f,"%s\n", (sizeof(testing) > sizeof(double)) ? "LDouble" :@@ -9459,15 +9440,17 @@ # include <sys/resource.h> #endif +#include <stdlib.h>+ typedef rlim_t testing; -main() {+int main(void) { FILE *f=fopen("conftestval", "w"); if (!f) exit(1); if (((testing)((int)((testing)1.4))) == ((testing)1.4)) { fprintf(f, "%s%d\n", ((testing)(-1) < (testing)0) ? "Int" : "Word",- sizeof(testing)*8);+ (int)(sizeof(testing)*8)); } else { fprintf(f,"%s\n", (sizeof(testing) > sizeof(double)) ? "LDouble" :@@ -9611,15 +9594,17 @@ # include <sys/resource.h> #endif +#include <stdlib.h>+ typedef wint_t testing; -main() {+int main(void) { FILE *f=fopen("conftestval", "w"); if (!f) exit(1); if (((testing)((int)((testing)1.4))) == ((testing)1.4)) { fprintf(f, "%s%d\n", ((testing)(-1) < (testing)0) ? "Int" : "Word",- sizeof(testing)*8);+ (int)(sizeof(testing)*8)); } else { fprintf(f,"%s\n", (sizeof(testing) > sizeof(double)) ? "LDouble" :@@ -9764,15 +9749,17 @@ # include <sys/resource.h> #endif +#include <stdlib.h>+ typedef intptr_t testing; -main() {+int main(void) { FILE *f=fopen("conftestval", "w"); if (!f) exit(1); if (((testing)((int)((testing)1.4))) == ((testing)1.4)) { fprintf(f, "%s%d\n", ((testing)(-1) < (testing)0) ? "Int" : "Word",- sizeof(testing)*8);+ (int)(sizeof(testing)*8)); } else { fprintf(f,"%s\n", (sizeof(testing) > sizeof(double)) ? "LDouble" :@@ -9916,15 +9903,17 @@ # include <sys/resource.h> #endif +#include <stdlib.h>+ typedef uintptr_t testing; -main() {+int main(void) { FILE *f=fopen("conftestval", "w"); if (!f) exit(1); if (((testing)((int)((testing)1.4))) == ((testing)1.4)) { fprintf(f, "%s%d\n", ((testing)(-1) < (testing)0) ? "Int" : "Word",- sizeof(testing)*8);+ (int)(sizeof(testing)*8)); } else { fprintf(f,"%s\n", (sizeof(testing) > sizeof(double)) ? "LDouble" :@@ -10076,15 +10065,17 @@ # include <sys/resource.h> #endif +#include <stdlib.h>+ typedef intmax_t testing; -main() {+int main(void) { FILE *f=fopen("conftestval", "w"); if (!f) exit(1); if (((testing)((int)((testing)1.4))) == ((testing)1.4)) { fprintf(f, "%s%d\n", ((testing)(-1) < (testing)0) ? "Int" : "Word",- sizeof(testing)*8);+ (int)(sizeof(testing)*8)); } else { fprintf(f,"%s\n", (sizeof(testing) > sizeof(double)) ? "LDouble" :@@ -10228,15 +10219,17 @@ # include <sys/resource.h> #endif +#include <stdlib.h>+ typedef uintmax_t testing; -main() {+int main(void) { FILE *f=fopen("conftestval", "w"); if (!f) exit(1); if (((testing)((int)((testing)1.4))) == ((testing)1.4)) { fprintf(f, "%s%d\n", ((testing)(-1) < (testing)0) ? "Int" : "Word",- sizeof(testing)*8);+ (int)(sizeof(testing)*8)); } else { fprintf(f,"%s\n", (sizeof(testing) > sizeof(double)) ? "LDouble" :@@ -11423,111 +11416,107 @@ _ACEOF -# Check for idiosyncracies in some mingw impls of directory handling.-{ echo "$as_me:$LINENO: checking what readdir sets errno to upon EOF" >&5-echo $ECHO_N "checking what readdir sets errno to upon EOF... $ECHO_C" >&6; }-if test "${fptools_cv_readdir_eof_errno+set}" = set; then+# We can't just use AC_SEARCH_LIBS for this, as on OpenBSD the iconv.h+# header needs to be included as iconv_open is #define'd to something+# else. We therefore use our own FP_SEARCH_LIBS_PROTO, which allows us+# to give prototype text.+{ echo "$as_me:$LINENO: checking for library containing iconv" >&5+echo $ECHO_N "checking for library containing iconv... $ECHO_C" >&6; }+if test "${ac_cv_search_iconv_t_cd________________________cd___iconv_open________________________________iconv_cd_NULL_NULL_NULL_NULL_________________________iconv_close_cd__+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else- if test "$cross_compiling" = yes; then- fptools_cv_readdir_eof_errno=0-else- cat >conftest.$ac_ext <<_ACEOF+ ac_func_search_save_LIBS=$LIBS+cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */-#include <dirent.h>-#include <stdio.h>-#include <errno.h>-int-main(argc, argv)-int argc;-char **argv;-{- FILE *f=fopen("conftestval", "w");-#if defined(__MINGW32__)- int fd = mkdir("testdir");-#else- int fd = mkdir("testdir", 0666);-#endif- DIR* dp;- struct dirent* de;- int err = 0; - if (!f) return 1;- if (fd == -1) {- fprintf(stderr,"unable to create directory; quitting.\n");- return 1;- }- close(fd);- dp = opendir("testdir");- if (!dp) {- fprintf(stderr,"unable to browse directory; quitting.\n");- rmdir("testdir");- return 1;- }+#include <stddef.h>+#include <iconv.h> - /* the assumption here is that readdir() will only return NULL- * due to reaching the end of the directory.- */- while (de = readdir(dp)) {- ;- }- err = errno;- fprintf(f,"%d", err);- fclose(f);- closedir(dp);- rmdir("testdir");+int+main ()+{+iconv_t cd;+ cd = iconv_open("", "");+ iconv(cd,NULL,NULL,NULL,NULL);+ iconv_close(cd);+ ; return 0; } _ACEOF-rm -f conftest$ac_exeext+for ac_lib in '' iconv; do+ if test -z "$ac_lib"; then+ ac_res="none required"+ else+ ac_res=-l$ac_lib+ LIBS="-l$ac_lib $ac_func_search_save_LIBS"+ fi+ rm -f conftest.$ac_objext conftest$ac_exeext if { (ac_try="$ac_link" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5- (eval "$ac_link") 2>&5- ac_status=$?- echo "$as_me:$LINENO: \$? = $ac_status" >&5- (exit $ac_status); } && { ac_try='./conftest$ac_exeext'- { (case "(($ac_try" in- *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;- *) ac_try_echo=$ac_try;;-esac-eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5- (eval "$ac_try") 2>&5+ (eval "$ac_link") 2>conftest.er1 ac_status=$?+ grep -v '^ *+' conftest.er1 >conftest.err+ rm -f conftest.er1+ cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5- (exit $ac_status); }; }; then- fptools_cv_readdir_eof_errno=`cat conftestval`+ (exit $ac_status); } && {+ test -z "$ac_c_werror_flag" ||+ test ! -s conftest.err+ } && test -s conftest$ac_exeext &&+ $as_test_x conftest$ac_exeext; then+ ac_cv_search_iconv_t_cd________________________cd___iconv_open________________________________iconv_cd_NULL_NULL_NULL_NULL_________________________iconv_close_cd__=$ac_res else- echo "$as_me: program exited with status $ac_status" >&5-echo "$as_me: failed program was:" >&5+ echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 -( exit $ac_status )-{ echo "$as_me:$LINENO: WARNING: failed to determine the errno value" >&5-echo "$as_me: WARNING: failed to determine the errno value" >&2;}- fptools_cv_readdir_eof_errno=0+ fi-rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext conftest.$ac_objext conftest.$ac_ext++rm -f core conftest.err conftest.$ac_objext conftest_ipa8_conftest.oo \+ conftest$ac_exeext+ if test "${ac_cv_search_iconv_t_cd________________________cd___iconv_open________________________________iconv_cd_NULL_NULL_NULL_NULL_________________________iconv_close_cd__+set}" = set; then+ break fi +done+if test "${ac_cv_search_iconv_t_cd________________________cd___iconv_open________________________________iconv_cd_NULL_NULL_NULL_NULL_________________________iconv_close_cd__+set}" = set; then+ :+else+ ac_cv_search_iconv_t_cd________________________cd___iconv_open________________________________iconv_cd_NULL_NULL_NULL_NULL_________________________iconv_close_cd__=no+fi +rm conftest.$ac_ext+LIBS=$ac_func_search_save_LIBS fi-{ echo "$as_me:$LINENO: result: $fptools_cv_readdir_eof_errno" >&5-echo "${ECHO_T}$fptools_cv_readdir_eof_errno" >&6; }+{ echo "$as_me:$LINENO: result: $ac_cv_search_iconv_t_cd________________________cd___iconv_open________________________________iconv_cd_NULL_NULL_NULL_NULL_________________________iconv_close_cd__" >&5+echo "${ECHO_T}$ac_cv_search_iconv_t_cd________________________cd___iconv_open________________________________iconv_cd_NULL_NULL_NULL_NULL_________________________iconv_close_cd__" >&6; }+ac_res=$ac_cv_search_iconv_t_cd________________________cd___iconv_open________________________________iconv_cd_NULL_NULL_NULL_NULL_________________________iconv_close_cd__+if test "$ac_res" != no; then+ test "$ac_res" = "none required" || LIBS="$ac_res $LIBS"+ EXTRA_LIBS="$EXTRA_LIBS $ac_lib"+else+ case `uname -s` in+ MINGW*|CYGWIN*) ;;+ *)+ { { echo "$as_me:$LINENO: error: iconv is required on non-Windows platforms" >&5+echo "$as_me: error: iconv is required on non-Windows platforms" >&2;}+ { (exit 1); exit 1; }; };;+ esac+fi -cat >>confdefs.h <<_ACEOF-#define READDIR_ERRNO_EOF $fptools_cv_readdir_eof_errno-_ACEOF +ac_config_files="$ac_config_files base.buildinfo" + cat >confcache <<\_ACEOF # This file is a shell script that caches the results of configure # tests run on this system so they can be shared between configure@@ -11940,6 +11929,7 @@ cat >>$CONFIG_STATUS <<_ACEOF # Files that config.status was made for.+config_files="$ac_config_files" config_headers="$ac_config_headers" _ACEOF@@ -11956,9 +11946,14 @@ -q, --quiet do not print progress messages -d, --debug don't remove temporary files --recheck update $as_me by reconfiguring in the same conditions+ --file=FILE[:TEMPLATE]+ instantiate the configuration file FILE --header=FILE[:TEMPLATE] instantiate the configuration header FILE +Configuration files:+$config_files+ Configuration headers: $config_headers @@ -12006,6 +12001,10 @@ echo "$ac_cs_version"; exit ;; --debug | --debu | --deb | --de | --d | -d ) debug=: ;;+ --file | --fil | --fi | --f )+ $ac_shift+ CONFIG_FILES="$CONFIG_FILES $ac_optarg"+ ac_need_defaults=false;; --header | --heade | --head | --hea ) $ac_shift CONFIG_HEADERS="$CONFIG_HEADERS $ac_optarg"@@ -12071,6 +12070,7 @@ do case $ac_config_target in "include/HsBaseConfig.h") CONFIG_HEADERS="$CONFIG_HEADERS include/HsBaseConfig.h" ;;+ "base.buildinfo") CONFIG_FILES="$CONFIG_FILES base.buildinfo" ;; *) { { echo "$as_me:$LINENO: error: invalid argument: $ac_config_target" >&5 echo "$as_me: error: invalid argument: $ac_config_target" >&2;}@@ -12084,6 +12084,7 @@ # We use the long form for the default assignment because of an extremely # bizarre bug on SunOS 4.1.3. if $ac_need_defaults; then+ test "${CONFIG_FILES+set}" = set || CONFIG_FILES=$config_files test "${CONFIG_HEADERS+set}" = set || CONFIG_HEADERS=$config_headers fi @@ -12116,8 +12117,133 @@ { (exit 1); exit 1; } } +#+# Set up the sed scripts for CONFIG_FILES section.+# -for ac_tag in :H $CONFIG_HEADERS+# No need to generate the scripts if there are no CONFIG_FILES.+# This happens for instance when ./config.status config.h+if test -n "$CONFIG_FILES"; then++_ACEOF++++ac_delim='%!_!# '+for ac_last_try in false false false false false :; do+ cat >conf$$subs.sed <<_ACEOF+SHELL!$SHELL$ac_delim+PATH_SEPARATOR!$PATH_SEPARATOR$ac_delim+PACKAGE_NAME!$PACKAGE_NAME$ac_delim+PACKAGE_TARNAME!$PACKAGE_TARNAME$ac_delim+PACKAGE_VERSION!$PACKAGE_VERSION$ac_delim+PACKAGE_STRING!$PACKAGE_STRING$ac_delim+PACKAGE_BUGREPORT!$PACKAGE_BUGREPORT$ac_delim+exec_prefix!$exec_prefix$ac_delim+prefix!$prefix$ac_delim+program_transform_name!$program_transform_name$ac_delim+bindir!$bindir$ac_delim+sbindir!$sbindir$ac_delim+libexecdir!$libexecdir$ac_delim+datarootdir!$datarootdir$ac_delim+datadir!$datadir$ac_delim+sysconfdir!$sysconfdir$ac_delim+sharedstatedir!$sharedstatedir$ac_delim+localstatedir!$localstatedir$ac_delim+includedir!$includedir$ac_delim+oldincludedir!$oldincludedir$ac_delim+docdir!$docdir$ac_delim+infodir!$infodir$ac_delim+htmldir!$htmldir$ac_delim+dvidir!$dvidir$ac_delim+pdfdir!$pdfdir$ac_delim+psdir!$psdir$ac_delim+libdir!$libdir$ac_delim+localedir!$localedir$ac_delim+mandir!$mandir$ac_delim+DEFS!$DEFS$ac_delim+ECHO_C!$ECHO_C$ac_delim+ECHO_N!$ECHO_N$ac_delim+ECHO_T!$ECHO_T$ac_delim+LIBS!$LIBS$ac_delim+build_alias!$build_alias$ac_delim+host_alias!$host_alias$ac_delim+target_alias!$target_alias$ac_delim+CC!$CC$ac_delim+CFLAGS!$CFLAGS$ac_delim+LDFLAGS!$LDFLAGS$ac_delim+CPPFLAGS!$CPPFLAGS$ac_delim+ac_ct_CC!$ac_ct_CC$ac_delim+EXEEXT!$EXEEXT$ac_delim+OBJEXT!$OBJEXT$ac_delim+CPP!$CPP$ac_delim+GREP!$GREP$ac_delim+EGREP!$EGREP$ac_delim+ICONV_INCLUDE_DIRS!$ICONV_INCLUDE_DIRS$ac_delim+ICONV_LIB_DIRS!$ICONV_LIB_DIRS$ac_delim+EXTRA_LIBS!$EXTRA_LIBS$ac_delim+LIBOBJS!$LIBOBJS$ac_delim+LTLIBOBJS!$LTLIBOBJS$ac_delim+_ACEOF++ if test `sed -n "s/.*$ac_delim\$/X/p" conf$$subs.sed | grep -c X` = 52; then+ break+ elif $ac_last_try; then+ { { echo "$as_me:$LINENO: error: could not make $CONFIG_STATUS" >&5+echo "$as_me: error: could not make $CONFIG_STATUS" >&2;}+ { (exit 1); exit 1; }; }+ else+ ac_delim="$ac_delim!$ac_delim _$ac_delim!! "+ fi+done++ac_eof=`sed -n '/^CEOF[0-9]*$/s/CEOF/0/p' conf$$subs.sed`+if test -n "$ac_eof"; then+ ac_eof=`echo "$ac_eof" | sort -nru | sed 1q`+ ac_eof=`expr $ac_eof + 1`+fi++cat >>$CONFIG_STATUS <<_ACEOF+cat >"\$tmp/subs-1.sed" <<\CEOF$ac_eof+/@[a-zA-Z_][a-zA-Z_0-9]*@/!b end+_ACEOF+sed '+s/[,\\&]/\\&/g; s/@/@|#_!!_#|/g+s/^/s,@/; s/!/@,|#_!!_#|/+:n+t n+s/'"$ac_delim"'$/,g/; t+s/$/\\/; p+N; s/^.*\n//; s/[,\\&]/\\&/g; s/@/@|#_!!_#|/g; b n+' >>$CONFIG_STATUS <conf$$subs.sed+rm -f conf$$subs.sed+cat >>$CONFIG_STATUS <<_ACEOF+:end+s/|#_!!_#|//g+CEOF$ac_eof+_ACEOF+++# VPATH may cause trouble with some makes, so we remove $(srcdir),+# ${srcdir} and @srcdir@ from VPATH if srcdir is ".", strip leading and+# trailing colons and then remove the whole line if VPATH becomes empty+# (actually we leave an empty line to preserve line numbers).+if test "x$srcdir" = x.; then+ ac_vpsub='/^[ ]*VPATH[ ]*=/{+s/:*\$(srcdir):*/:/+s/:*\${srcdir}:*/:/+s/:*@srcdir@:*/:/+s/^\([^=]*=[ ]*\):*/\1/+s/:*$//+s/^[^=]*=[ ]*$//+}'+fi++cat >>$CONFIG_STATUS <<\_ACEOF+fi # test -n "$CONFIG_FILES"+++for ac_tag in :F $CONFIG_FILES :H $CONFIG_HEADERS do case $ac_tag in :[FHLC]) ac_mode=$ac_tag; continue;;@@ -12278,7 +12404,80 @@ case $ac_mode in+ :F)+ #+ # CONFIG_FILE+ # +_ACEOF++cat >>$CONFIG_STATUS <<\_ACEOF+# If the template does not know about datarootdir, expand it.+# FIXME: This hack should be removed a few years after 2.60.+ac_datarootdir_hack=; ac_datarootdir_seen=++case `sed -n '/datarootdir/ {+ p+ q+}+/@datadir@/p+/@docdir@/p+/@infodir@/p+/@localedir@/p+/@mandir@/p+' $ac_file_inputs` in+*datarootdir*) ac_datarootdir_seen=yes;;+*@datadir@*|*@docdir@*|*@infodir@*|*@localedir@*|*@mandir@*)+ { echo "$as_me:$LINENO: WARNING: $ac_file_inputs seems to ignore the --datarootdir setting" >&5+echo "$as_me: WARNING: $ac_file_inputs seems to ignore the --datarootdir setting" >&2;}+_ACEOF+cat >>$CONFIG_STATUS <<_ACEOF+ ac_datarootdir_hack='+ s&@datadir@&$datadir&g+ s&@docdir@&$docdir&g+ s&@infodir@&$infodir&g+ s&@localedir@&$localedir&g+ s&@mandir@&$mandir&g+ s&\\\${datarootdir}&$datarootdir&g' ;;+esac+_ACEOF++# Neutralize VPATH when `$srcdir' = `.'.+# Shell code in configure.ac might set extrasub.+# FIXME: do we really want to maintain this feature?+cat >>$CONFIG_STATUS <<_ACEOF+ sed "$ac_vpsub+$extrasub+_ACEOF+cat >>$CONFIG_STATUS <<\_ACEOF+:t+/@[a-zA-Z_][a-zA-Z_0-9]*@/!b+s&@configure_input@&$configure_input&;t t+s&@top_builddir@&$ac_top_builddir_sub&;t t+s&@srcdir@&$ac_srcdir&;t t+s&@abs_srcdir@&$ac_abs_srcdir&;t t+s&@top_srcdir@&$ac_top_srcdir&;t t+s&@abs_top_srcdir@&$ac_abs_top_srcdir&;t t+s&@builddir@&$ac_builddir&;t t+s&@abs_builddir@&$ac_abs_builddir&;t t+s&@abs_top_builddir@&$ac_abs_top_builddir&;t t+$ac_datarootdir_hack+" $ac_file_inputs | sed -f "$tmp/subs-1.sed" >$tmp/out++test -z "$ac_datarootdir_hack$ac_datarootdir_seen" &&+ { ac_out=`sed -n '/\${datarootdir}/p' "$tmp/out"`; test -n "$ac_out"; } &&+ { ac_out=`sed -n '/^[ ]*datarootdir[ ]*:*=/p' "$tmp/out"`; test -z "$ac_out"; } &&+ { echo "$as_me:$LINENO: WARNING: $ac_file contains a reference to the variable \`datarootdir'+which seems to be undefined. Please make sure it is defined." >&5+echo "$as_me: WARNING: $ac_file contains a reference to the variable \`datarootdir'+which seems to be undefined. Please make sure it is defined." >&2;}++ rm -f "$tmp/stdin"+ case $ac_file in+ -) cat "$tmp/out"; rm -f "$tmp/out";;+ *) rm -f "$ac_file"; mv "$tmp/out" $ac_file;;+ esac+ ;; :H) # # CONFIG_HEADER
configure.ac view
@@ -13,14 +13,11 @@ # do we have long longs? AC_CHECK_TYPES([long long]) -dnl ** determine whether or not const works-AC_C_CONST- dnl ** check for full ANSI header (.h) files AC_HEADER_STDC # check for specific header (.h) files that we are interested in-AC_CHECK_HEADERS([ctype.h dirent.h errno.h fcntl.h inttypes.h limits.h signal.h sys/resource.h sys/select.h sys/stat.h sys/syscall.h sys/time.h sys/timeb.h sys/timers.h sys/times.h sys/types.h sys/utsname.h sys/wait.h termios.h time.h unistd.h utime.h windows.h winsock.h])+AC_CHECK_HEADERS([ctype.h errno.h fcntl.h inttypes.h limits.h signal.h sys/resource.h sys/select.h sys/stat.h sys/syscall.h sys/time.h sys/timeb.h sys/timers.h sys/times.h sys/types.h sys/utsname.h sys/wait.h termios.h time.h unistd.h utime.h windows.h winsock.h langinfo.h]) # Enable large file support. Do this before testing the types ino_t, off_t, and # rlim_t, because it will affect the result of that test.@@ -31,10 +28,29 @@ dnl functions if it's really there. AC_CHECK_HEADERS([wctype.h], [AC_CHECK_FUNCS(iswspace)]) -AC_CHECK_FUNCS([lstat readdir_r])+AC_CHECK_FUNCS([lstat]) AC_CHECK_FUNCS([getclock getrusage times]) AC_CHECK_FUNCS([_chsize ftruncate]) +dnl--------------------------------------------------------------------+dnl * Deal with arguments telling us iconv is somewhere odd+dnl--------------------------------------------------------------------++AC_ARG_WITH([iconv-includes],+ [AC_HELP_STRING([--with-iconv-includes],+ [directory containing iconv.h])],+ [ICONV_INCLUDE_DIRS=$withval; CPPFLAGS="-I$withval"],+ [ICONV_INCLUDE_DIRS=])++AC_ARG_WITH([iconv-libraries],+ [AC_HELP_STRING([--with-iconv-libraries],+ [directory containing iconv library])],+ [ICONV_LIB_DIRS=$withval; LDFLAGS="-L$withval"],+ [ICONV_LIB_DIRS=])++AC_SUBST(ICONV_INCLUDE_DIRS)+AC_SUBST(ICONV_LIB_DIRS)+ # map standard C types and ISO types to Haskell types FPTOOLS_CHECK_HTYPE(char) FPTOOLS_CHECK_HTYPE(signed char)@@ -99,7 +115,28 @@ dnl ** can we open files in binary mode? FP_CHECK_CONST([O_BINARY], [#include <fcntl.h>], [0]) -# Check for idiosyncracies in some mingw impls of directory handling.-FP_READDIR_EOF_ERRNO+# We can't just use AC_SEARCH_LIBS for this, as on OpenBSD the iconv.h+# header needs to be included as iconv_open is #define'd to something+# else. We therefore use our own FP_SEARCH_LIBS_PROTO, which allows us+# to give prototype text.+FP_SEARCH_LIBS_PROTO(iconv,+ [+#include <stddef.h>+#include <iconv.h>+ ],+ [iconv_t cd;+ cd = iconv_open("", "");+ iconv(cd,NULL,NULL,NULL,NULL);+ iconv_close(cd);],+ iconv,+ [EXTRA_LIBS="$EXTRA_LIBS $ac_lib"],+ [case `uname -s` in+ MINGW*|CYGWIN*) ;;+ *)+ AC_MSG_ERROR([iconv is required on non-Windows platforms]);;+ esac])++AC_SUBST(EXTRA_LIBS)+AC_CONFIG_FILES([base.buildinfo]) AC_OUTPUT
include/HsBase.h view
@@ -9,7 +9,11 @@ #ifndef __HSBASE_H__ #define __HSBASE_H__ +#ifdef __NHC__+# include "Nhc98BaseConfig.h"+#else #include "HsBaseConfig.h"+#endif /* ultra-evil... */ #undef PACKAGE_BUGREPORT@@ -58,9 +62,6 @@ #if HAVE_STRING_H #include <string.h> #endif-#if HAVE_DIRENT_H-#include <dirent.h>-#endif #if HAVE_UTIME_H #include <utime.h> #endif@@ -125,7 +126,6 @@ #if HAVE_VFORK_H #include <vfork.h> #endif-#include "dirUtils.h" #include "WCsubst.h" #if defined(__MINGW32__)@@ -152,59 +152,6 @@ extern HsInt nocldstop; /* ------------------------------------------------------------------------------ 64-bit operations, defined in longlong.c- -------------------------------------------------------------------------- */--#ifdef SUPPORT_LONG_LONGS--HsBool hs_gtWord64 (HsWord64, HsWord64);-HsBool hs_geWord64 (HsWord64, HsWord64);-HsBool hs_eqWord64 (HsWord64, HsWord64);-HsBool hs_neWord64 (HsWord64, HsWord64);-HsBool hs_ltWord64 (HsWord64, HsWord64);-HsBool hs_leWord64 (HsWord64, HsWord64);--HsBool hs_gtInt64 (HsInt64, HsInt64);-HsBool hs_geInt64 (HsInt64, HsInt64);-HsBool hs_eqInt64 (HsInt64, HsInt64);-HsBool hs_neInt64 (HsInt64, HsInt64);-HsBool hs_ltInt64 (HsInt64, HsInt64);-HsBool hs_leInt64 (HsInt64, HsInt64);--HsWord64 hs_remWord64 (HsWord64, HsWord64);-HsWord64 hs_quotWord64 (HsWord64, HsWord64);--HsInt64 hs_remInt64 (HsInt64, HsInt64);-HsInt64 hs_quotInt64 (HsInt64, HsInt64);-HsInt64 hs_negateInt64 (HsInt64);-HsInt64 hs_plusInt64 (HsInt64, HsInt64);-HsInt64 hs_minusInt64 (HsInt64, HsInt64);-HsInt64 hs_timesInt64 (HsInt64, HsInt64);--HsWord64 hs_and64 (HsWord64, HsWord64);-HsWord64 hs_or64 (HsWord64, HsWord64);-HsWord64 hs_xor64 (HsWord64, HsWord64);-HsWord64 hs_not64 (HsWord64);--HsWord64 hs_uncheckedShiftL64 (HsWord64, HsInt);-HsWord64 hs_uncheckedShiftRL64 (HsWord64, HsInt);-HsInt64 hs_uncheckedIShiftL64 (HsInt64, HsInt);-HsInt64 hs_uncheckedIShiftRA64 (HsInt64, HsInt);-HsInt64 hs_uncheckedIShiftRL64 (HsInt64, HsInt);--HsInt64 hs_intToInt64 (HsInt);-HsInt hs_int64ToInt (HsInt64);-HsWord64 hs_int64ToWord64 (HsInt64);-HsWord64 hs_wordToWord64 (HsWord);-HsWord hs_word64ToWord (HsWord64);-HsInt64 hs_word64ToInt64 (HsWord64);--HsWord64 hs_integerToWord64 (HsInt sa, StgByteArray /* Really: mp_limb_t* */ da);-HsInt64 hs_integerToInt64 (HsInt sa, StgByteArray /* Really: mp_limb_t* */ da);--#endif /* SUPPORT_LONG_LONGS */--/* ----------------------------------------------------------------------------- INLINE functions. These functions are given as inlines here for when compiling via C,@@ -254,8 +201,13 @@ INLINE int __hscore_sigismember( sigset_t * set, int s ) { return sigismember(set,s); }++INLINE int+__hscore_utime( const char *file, const struct utimbuf *timep )+{ return utime(file,timep); } #endif +// This is used by dph:Data.Array.Parallel.Arr.BUArr, and shouldn't be INLINE void * __hscore_memcpy_dst_off( char *dst, int dst_off, char *src, size_t sz ) { return memcpy(dst+dst_off, src, sz); }@@ -264,16 +216,6 @@ __hscore_memcpy_src_off( char *dst, char *src, int src_off, size_t sz ) { return memcpy(dst, src+src_off, sz); } -INLINE HsBool-__hscore_supportsTextMode()-{-#if defined(_MSC_VER) || defined(__MINGW32__) || defined(_WIN32)- return HS_BOOL_FALSE;-#else- return HS_BOOL_TRUE;-#endif-}- INLINE HsInt __hscore_bufsiz() {@@ -425,82 +367,13 @@ #if __GLASGOW_HASKELL__ -INLINE int-__hscore_PrelHandle_write( int fd, void *ptr, HsInt off, int sz )-{- return write(fd,(char *)ptr + off, sz);-}--INLINE int-__hscore_PrelHandle_read( int fd, void *ptr, HsInt off, int sz )-{- return read(fd,(char *)ptr + off, sz);--}--#if defined(_MSC_VER) || defined(__MINGW32__) || defined(_WIN32)-INLINE int-__hscore_PrelHandle_send( int fd, void *ptr, HsInt off, int sz )-{- return send(fd,(char *)ptr + off, sz, 0);-}--INLINE int-__hscore_PrelHandle_recv( int fd, void *ptr, HsInt off, int sz )-{- return recv(fd,(char *)ptr + off, sz, 0);-}-#endif- #endif /* __GLASGOW_HASKELL__ */ -INLINE int-__hscore_mkdir( char *pathName, int mode )-{-#if defined(_MSC_VER) || defined(__MINGW32__) || defined(_WIN32)- return mkdir(pathName);-#else- return mkdir(pathName,mode);-#endif-}--INLINE int-__hscore_lstat( const char *fname, struct stat *st )-{-#if HAVE_LSTAT- return lstat(fname, st);-#else- return stat(fname, st);-#endif-}--INLINE char *-__hscore_d_name( struct dirent* d )-{- return (d->d_name);-}--INLINE int-__hscore_end_of_dir( void )-{- return READDIR_ERRNO_EOF;-}--INLINE void-__hscore_free_dirent(struct dirent *dEnt)-{-#if HAVE_READDIR_R- free(dEnt);-#endif-}- #if defined(__MINGW32__) // We want the versions of stat/fstat/lseek that use 64-bit offsets, // and you have to ask for those explicitly. Unfortunately there // doesn't seem to be a 64-bit version of truncate/ftruncate, so while // hFileSize and hSeek will work with large files, hSetFileSize will not.-#define stat(file,buf) _stati64(file,buf)-#define fstat(fd,buf) _fstati64(fd,buf) typedef struct _stati64 struct_stat; typedef off64_t stsize_t; #else@@ -522,6 +395,37 @@ INLINE ino_t __hscore_st_ino ( struct_stat* st ) { return st->st_ino; } #endif +#if defined(__MINGW32__)+INLINE int __hscore_stat(wchar_t *file, struct_stat *buf) {+ return _wstati64(file,buf);+}++INLINE int __hscore_fstat(int fd, struct_stat *buf) {+ return _fstati64(fd,buf);+}+INLINE int __hscore_lstat(wchar_t *fname, struct_stat *buf )+{+ return _wstati64(fname,buf);+}+#else+INLINE int __hscore_stat(char *file, struct_stat *buf) {+ return stat(file,buf);+}++INLINE int __hscore_fstat(int fd, struct_stat *buf) {+ return fstat(fd,buf);+}++INLINE int __hscore_lstat( const char *fname, struct stat *buf )+{+#if HAVE_LSTAT+ return lstat(fname, buf);+#else+ return stat(fname, buf);+#endif+}+#endif+ #if HAVE_TERMIOS_H INLINE tcflag_t __hscore_lflag( struct termios* ts ) { return ts->c_lflag; } @@ -681,16 +585,20 @@ INLINE int __hscore_hs_fileno (FILE *f) { return fileno (f); } -INLINE int __hscore_open(char *file, int how, mode_t mode) { #ifdef __MINGW32__+INLINE int __hscore_open(wchar_t *file, int how, mode_t mode) { if ((how & O_WRONLY) || (how & O_RDWR) || (how & O_APPEND))- return _sopen(file,how,_SH_DENYRW,mode);+ return _wsopen(file,how | _O_NOINHERIT,_SH_DENYRW,mode);+ // _O_NOINHERIT: see #2650 else- return _sopen(file,how,_SH_DENYWR,mode);+ return _wsopen(file,how | _O_NOINHERIT,_SH_DENYWR,mode);+ // _O_NOINHERIT: see #2650+} #else+INLINE int __hscore_open(char *file, int how, mode_t mode) { return open(file,how,mode);-#endif }+#endif // These are wrapped because on some OSs (eg. Linux) they are // macros which redirect to the 64-bit-off_t versions when large file@@ -706,14 +614,6 @@ } #endif -INLINE int __hscore_stat(char *file, struct_stat *buf) {- return (stat(file,buf));-}--INLINE int __hscore_fstat(int fd, struct_stat *buf) {- return (fstat(fd,buf));-}- // select-related stuff #if !defined(__MINGW32__)@@ -724,6 +624,11 @@ extern void hsFD_ZERO(fd_set *fds); #endif +INLINE int __hscore_select(int nfds, fd_set *readfds, fd_set *writefds,+ fd_set *exceptfds, struct timeval *timeout) {+ return (select(nfds,readfds,writefds,exceptfds,timeout));+}+ // gettimeofday()-related #if !defined(__MINGW32__)@@ -760,6 +665,20 @@ void errorBelch2(const char*s, char *t); void debugBelch2(const char*s, char *t);++#if !defined(mingw32_HOST_OS) && !defined(__MINGW32__)++INLINE int fcntl_read(int fd, int cmd) {+ return fcntl(fd, cmd);+}+INLINE int fcntl_write(int fd, int cmd, long arg) {+ return fcntl(fd, cmd, arg);+}+INLINE int fcntl_lock(int fd, int cmd, struct flock *lock) {+ return fcntl(fd, cmd, lock);+}++#endif #endif /* __HSBASE_H__ */
include/HsBaseConfig.h view
@@ -307,9 +307,6 @@ /* Define to 1 if you have the <ctype.h> header file. */ #define HAVE_CTYPE_H 1 -/* Define to 1 if you have the <dirent.h> header file. */-#define HAVE_DIRENT_H 1- /* Define to 1 if you have the <errno.h> header file. */ #define HAVE_ERRNO_H 1 @@ -331,6 +328,9 @@ /* Define to 1 if you have the `iswspace' function. */ #define HAVE_ISWSPACE 1 +/* Define to 1 if you have the <langinfo.h> header file. */+#define HAVE_LANGINFO_H 1+ /* Define to 1 if you have the <limits.h> header file. */ #define HAVE_LIMITS_H 1 @@ -343,9 +343,6 @@ /* Define to 1 if you have the <memory.h> header file. */ #define HAVE_MEMORY_H 1 -/* Define to 1 if you have the `readdir_r' function. */-#define HAVE_READDIR_R 1- /* Define to 1 if you have the <signal.h> header file. */ #define HAVE_SIGNAL_H 1 @@ -428,7 +425,7 @@ #define HTYPE_CHAR Int8 /* Define to Haskell type for clock_t */-#define HTYPE_CLOCK_T Int32+#define HTYPE_CLOCK_T Int64 /* Define to Haskell type for dev_t */ #define HTYPE_DEV_T Word64@@ -452,10 +449,10 @@ #define HTYPE_INTMAX_T Int64 /* Define to Haskell type for intptr_t */-#define HTYPE_INTPTR_T Int32+#define HTYPE_INTPTR_T Int64 /* Define to Haskell type for long */-#define HTYPE_LONG Int32+#define HTYPE_LONG Int64 /* Define to Haskell type for long long */ #define HTYPE_LONG_LONG Int64@@ -464,7 +461,7 @@ #define HTYPE_MODE_T Word32 /* Define to Haskell type for nlink_t */-#define HTYPE_NLINK_T Word32+#define HTYPE_NLINK_T Word64 /* Define to Haskell type for off_t */ #define HTYPE_OFF_T Int64@@ -473,7 +470,7 @@ #define HTYPE_PID_T Int32 /* Define to Haskell type for ptrdiff_t */-#define HTYPE_PTRDIFF_T Int32+#define HTYPE_PTRDIFF_T Int64 /* Define to Haskell type for rlim_t */ #define HTYPE_RLIM_T Word64@@ -488,19 +485,19 @@ #define HTYPE_SIG_ATOMIC_T Int32 /* Define to Haskell type for size_t */-#define HTYPE_SIZE_T Word32+#define HTYPE_SIZE_T Word64 /* Define to Haskell type for speed_t */ #define HTYPE_SPEED_T Word32 /* Define to Haskell type for ssize_t */-#define HTYPE_SSIZE_T Int32+#define HTYPE_SSIZE_T Int64 /* Define to Haskell type for tcflag_t */ #define HTYPE_TCFLAG_T Word32 /* Define to Haskell type for time_t */-#define HTYPE_TIME_T Int32+#define HTYPE_TIME_T Int64 /* Define to Haskell type for uid_t */ #define HTYPE_UID_T Word32@@ -509,7 +506,7 @@ #define HTYPE_UINTMAX_T Word64 /* Define to Haskell type for uintptr_t */-#define HTYPE_UINTPTR_T Word32+#define HTYPE_UINTPTR_T Word64 /* Define to Haskell type for unsigned char */ #define HTYPE_UNSIGNED_CHAR Word8@@ -518,7 +515,7 @@ #define HTYPE_UNSIGNED_INT Word32 /* Define to Haskell type for unsigned long */-#define HTYPE_UNSIGNED_LONG Word32+#define HTYPE_UNSIGNED_LONG Word64 /* Define to Haskell type for unsigned long long */ #define HTYPE_UNSIGNED_LONG_LONG Word64@@ -547,17 +544,11 @@ /* Define to the version of this package. */ #define PACKAGE_VERSION "1.0" -/* readdir() sets errno to this upon EOF */-#define READDIR_ERRNO_EOF 0- /* Define to 1 if you have the ANSI C header files. */ #define STDC_HEADERS 1 /* Number of bits in a file offset, on hosts where this is settable. */-#define _FILE_OFFSET_BITS 64+/* #undef _FILE_OFFSET_BITS */ /* Define for large files, on AIX-style hosts. */ /* #undef _LARGE_FILES */--/* Define to empty if `const' does not conform to ANSI C. */-/* #undef const */
− include/dirUtils.h
@@ -1,11 +0,0 @@-/* - * (c) The University of Glasgow 2002- *- * Directory Runtime Support- */-#ifndef __DIRUTILS_H__-#define __DIRUTILS_H__--extern int __hscore_readdir(DIR *dirPtr, struct dirent **pDirEnt);--#endif /* __DIRUTILS_H__ */