diff --git a/Control/Applicative.hs b/Control/Applicative.hs --- a/Control/Applicative.hs +++ b/Control/Applicative.hs @@ -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 diff --git a/Control/Arrow.hs b/Control/Arrow.hs --- a/Control/Arrow.hs +++ b/Control/Arrow.hs @@ -39,7 +39,6 @@ ) where import Prelude hiding (id,(.)) -import qualified Prelude import Control.Monad import Control.Monad.Fix diff --git a/Control/Category.hs b/Control/Category.hs --- a/Control/Category.hs +++ b/Control/Category.hs @@ -12,7 +12,6 @@ module Control.Category where -import Prelude hiding (id,(.)) import qualified Prelude infixr 9 . diff --git a/Control/Concurrent.hs b/Control/Concurrent.hs --- a/Control/Concurrent.hs +++ b/Control/Concurrent.hs @@ -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 diff --git a/Control/Concurrent/MVar.hs b/Control/Concurrent/MVar.hs --- a/Control/Concurrent/MVar.hs +++ b/Control/Concurrent/MVar.hs @@ -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 diff --git a/Control/Concurrent/QSem.hs b/Control/Concurrent/QSem.hs --- a/Control/Concurrent/QSem.hs +++ b/Control/Concurrent/QSem.hs @@ -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 () diff --git a/Control/Concurrent/QSemN.hs b/Control/Concurrent/QSemN.hs --- a/Control/Concurrent/QSemN.hs +++ b/Control/Concurrent/QSemN.hs @@ -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 () diff --git a/Control/Concurrent/SampleVar.hs b/Control/Concurrent/SampleVar.hs --- a/Control/Concurrent/SampleVar.hs +++ b/Control/Concurrent/SampleVar.hs @@ -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) diff --git a/Control/Exception.hs b/Control/Exception.hs --- a/Control/Exception.hs +++ b/Control/Exception.hs @@ -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) diff --git a/Control/Exception/Base.hs b/Control/Exception/Base.hs --- a/Control/Exception/Base.hs +++ b/Control/Exception/Base.hs @@ -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")) diff --git a/Control/Monad/ST.hs b/Control/Monad/ST.hs --- a/Control/Monad/ST.hs +++ b/Control/Monad/ST.hs @@ -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 diff --git a/Control/Monad/ST/Lazy.hs b/Control/Monad/ST/Lazy.hs --- a/Control/Monad/ST/Lazy.hs +++ b/Control/Monad/ST/Lazy.hs @@ -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__ diff --git a/Control/Monad/ST/Strict.hs b/Control/Monad/ST/Strict.hs --- a/Control/Monad/ST/Strict.hs +++ b/Control/Monad/ST/Strict.hs @@ -16,5 +16,4 @@ module Control.Monad.ST ) where -import Prelude import Control.Monad.ST diff --git a/Control/OldException.hs b/Control/OldException.hs --- a/Control/OldException.hs +++ b/Control/OldException.hs @@ -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 diff --git a/Data/Bits.hs b/Data/Bits.hs --- a/Data/Bits.hs +++ b/Data/Bits.hs @@ -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 diff --git a/Data/Data.hs b/Data/Data.hs --- a/Data/Data.hs +++ b/Data/Data.hs @@ -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" diff --git a/Data/Dynamic.hs b/Data/Dynamic.hs --- a/Data/Dynamic.hs +++ b/Data/Dynamic.hs @@ -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 diff --git a/Data/Fixed.hs b/Data/Fixed.hs --- a/Data/Fixed.hs +++ b/Data/Fixed.hs @@ -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 @@ -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 diff --git a/Data/Foldable.hs b/Data/Foldable.hs --- a/Data/Foldable.hs +++ b/Data/Foldable.hs @@ -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 diff --git a/Data/Functor.hs b/Data/Functor.hs new file mode 100644 --- /dev/null +++ b/Data/Functor.hs @@ -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 diff --git a/Data/HashTable.hs b/Data/HashTable.hs --- a/Data/HashTable.hs +++ b/Data/HashTable.hs @@ -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 } ) diff --git a/Data/IORef.hs b/Data/IORef.hs --- a/Data/IORef.hs +++ b/Data/IORef.hs @@ -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 diff --git a/Data/Ix.hs b/Data/Ix.hs --- a/Data/Ix.hs +++ b/Data/Ix.hs @@ -60,7 +60,7 @@ ) where -import Prelude +-- import Prelude #ifdef __GLASGOW_HASKELL__ import GHC.Arr diff --git a/Data/List.hs b/Data/List.hs --- a/Data/List.hs +++ b/Data/List.hs @@ -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. diff --git a/Data/Monoid.hs b/Data/Monoid.hs --- a/Data/Monoid.hs +++ b/Data/Monoid.hs @@ -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 () --- 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 diff --git a/Data/STRef/Lazy.hs b/Data/STRef/Lazy.hs --- a/Data/STRef/Lazy.hs +++ b/Data/STRef/Lazy.hs @@ -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 diff --git a/Data/STRef/Strict.hs b/Data/STRef/Strict.hs --- a/Data/STRef/Strict.hs +++ b/Data/STRef/Strict.hs @@ -16,5 +16,4 @@ module Data.STRef ) where -import Prelude import Data.STRef diff --git a/Data/Tuple.hs b/Data/Tuple.hs --- a/Data/Tuple.hs +++ b/Data/Tuple.hs @@ -75,6 +75,10 @@ ) #endif +#ifdef __GLASGOW_HASKELL__ +import GHC.Unit () +#endif + default () -- Double isn't available yet #ifdef __GLASGOW_HASKELL__ diff --git a/Data/Typeable.hs b/Data/Typeable.hs --- a/Data/Typeable.hs +++ b/Data/Typeable.hs @@ -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") diff --git a/Data/Typeable.hs-boot b/Data/Typeable.hs-boot --- a/Data/Typeable.hs-boot +++ b/Data/Typeable.hs-boot @@ -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 diff --git a/Foreign/C/Error.hs b/Foreign/C/Error.hs --- a/Foreign/C/Error.hs +++ b/Foreign/C/Error.hs @@ -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 diff --git a/Foreign/C/String.hs b/Foreign/C/String.hs --- a/Foreign/C/String.hs +++ b/Foreign/C/String.hs @@ -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 ) diff --git a/Foreign/C/Types.hs b/Foreign/C/Types.hs --- a/Foreign/C/Types.hs +++ b/Foreign/C/Types.hs @@ -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) diff --git a/Foreign/Concurrent.hs b/Foreign/Concurrent.hs --- a/Foreign/Concurrent.hs +++ b/Foreign/Concurrent.hs @@ -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 () diff --git a/Foreign/ForeignPtr.hs b/Foreign/ForeignPtr.hs --- a/Foreign/ForeignPtr.hs +++ b/Foreign/ForeignPtr.hs @@ -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 diff --git a/Foreign/Marshal/Alloc.hs b/Foreign/Marshal/Alloc.hs --- a/Foreign/Marshal/Alloc.hs +++ b/Foreign/Marshal/Alloc.hs @@ -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 diff --git a/Foreign/Marshal/Array.hs b/Foreign/Marshal/Array.hs --- a/Foreign/Marshal/Array.hs +++ b/Foreign/Marshal/Array.hs @@ -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 diff --git a/Foreign/Marshal/Error.hs b/Foreign/Marshal/Error.hs --- a/Foreign/Marshal/Error.hs +++ b/Foreign/Marshal/Error.hs @@ -37,7 +37,8 @@ #endif import GHC.Base import GHC.Num -import GHC.IOBase +-- import GHC.IO +import GHC.IO.Exception #endif -- exported functions diff --git a/Foreign/Marshal/Pool.hs b/Foreign/Marshal/Pool.hs --- a/Foreign/Marshal/Pool.hs +++ b/Foreign/Marshal/Pool.hs @@ -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) diff --git a/Foreign/Marshal/Utils.hs b/Foreign/Marshal/Utils.hs --- a/Foreign/Marshal/Utils.hs +++ b/Foreign/Marshal/Utils.hs @@ -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 () diff --git a/Foreign/Ptr.hs b/Foreign/Ptr.hs --- a/Foreign/Ptr.hs +++ b/Foreign/Ptr.hs @@ -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 ) diff --git a/Foreign/Storable.hs b/Foreign/Storable.hs --- a/Foreign/Storable.hs +++ b/Foreign/Storable.hs @@ -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 diff --git a/Foreign/Storable.hs-boot b/Foreign/Storable.hs-boot deleted file mode 100644 --- a/Foreign/Storable.hs-boot +++ /dev/null @@ -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 - diff --git a/GHC/Arr.lhs b/GHC/Arr.lhs --- a/GHC/Arr.lhs +++ b/GHC/Arr.lhs @@ -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)] diff --git a/GHC/Base.lhs b/GHC/Base.lhs --- a/GHC/Base.lhs +++ b/GHC/Base.lhs @@ -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 diff --git a/GHC/Conc.lhs b/GHC/Conc.lhs --- a/GHC/Conc.lhs +++ b/GHC/Conc.lhs @@ -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} diff --git a/GHC/ConsoleHandler.hs b/GHC/ConsoleHandler.hs --- a/GHC/ConsoleHandler.hs +++ b/GHC/ConsoleHandler.hs @@ -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 */ diff --git a/GHC/Constants.hs b/GHC/Constants.hs new file mode 100644 --- /dev/null +++ b/GHC/Constants.hs @@ -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" diff --git a/GHC/Desugar.hs b/GHC/Desugar.hs --- a/GHC/Desugar.hs +++ b/GHC/Desugar.hs @@ -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 diff --git a/GHC/Enum.lhs b/GHC/Enum.lhs --- a/GHC/Enum.lhs +++ b/GHC/Enum.lhs @@ -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 diff --git a/GHC/Err.lhs-boot b/GHC/Err.lhs-boot new file mode 100644 --- /dev/null +++ b/GHC/Err.lhs-boot @@ -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} diff --git a/GHC/Exception.lhs b/GHC/Exception.lhs --- a/GHC/Exception.lhs +++ b/GHC/Exception.lhs @@ -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} diff --git a/GHC/Exts.hs b/GHC/Exts.hs --- a/GHC/Exts.hs +++ b/GHC/Exts.hs @@ -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', () #) diff --git a/GHC/Float.lhs b/GHC/Float.lhs --- a/GHC/Float.lhs +++ b/GHC/Float.lhs @@ -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 diff --git a/GHC/ForeignPtr.hs b/GHC/ForeignPtr.hs --- a/GHC/ForeignPtr.hs +++ b/GHC/ForeignPtr.hs @@ -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 diff --git a/GHC/Handle.hs b/GHC/Handle.hs --- a/GHC/Handle.hs +++ b/GHC/Handle.hs @@ -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 "" 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 "" 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 "" 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 = "" - 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 diff --git a/GHC/Handle.hs-boot b/GHC/Handle.hs-boot deleted file mode 100644 --- a/GHC/Handle.hs-boot +++ /dev/null @@ -1,9 +0,0 @@ -{-# OPTIONS_GHC -XNoImplicitPrelude #-} - -module GHC.Handle where - -import GHC.IOBase - -stdout :: Handle -stderr :: Handle -hFlush :: Handle -> IO () diff --git a/GHC/IO.hs b/GHC/IO.hs --- a/GHC/IO.hs +++ b/GHC/IO.hs @@ -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 diff --git a/GHC/IO.hs-boot b/GHC/IO.hs-boot new file mode 100644 --- /dev/null +++ b/GHC/IO.hs-boot @@ -0,0 +1,5 @@ +module GHC.IO where + +import GHC.Types + +failIO :: [Char] -> IO a diff --git a/GHC/IO/Buffer.hs b/GHC/IO/Buffer.hs new file mode 100644 --- /dev/null +++ b/GHC/IO/Buffer.hs @@ -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) diff --git a/GHC/IO/BufferedIO.hs b/GHC/IO/BufferedIO.hs new file mode 100644 --- /dev/null +++ b/GHC/IO/BufferedIO.hs @@ -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) diff --git a/GHC/IO/Device.hs b/GHC/IO/Device.hs new file mode 100644 --- /dev/null +++ b/GHC/IO/Device.hs @@ -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) diff --git a/GHC/IO/Encoding.hs b/GHC/IO/Encoding.hs new file mode 100644 --- /dev/null +++ b/GHC/IO/Encoding.hs @@ -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 diff --git a/GHC/IO/Encoding/CodePage.hs b/GHC/IO/Encoding/CodePage.hs new file mode 100644 --- /dev/null +++ b/GHC/IO/Encoding/CodePage.hs @@ -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 diff --git a/GHC/IO/Encoding/CodePage/Table.hs b/GHC/IO/Encoding/CodePage/Table.hs new file mode 100644 --- /dev/null +++ b/GHC/IO/Encoding/CodePage/Table.hs @@ -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' + } + + } + ) + ] diff --git a/GHC/IO/Encoding/Iconv.hs b/GHC/IO/Encoding/Iconv.hs new file mode 100644 --- /dev/null +++ b/GHC/IO/Encoding/Iconv.hs @@ -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 */ diff --git a/GHC/IO/Encoding/Latin1.hs b/GHC/IO/Encoding/Latin1.hs new file mode 100644 --- /dev/null +++ b/GHC/IO/Encoding/Latin1.hs @@ -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) diff --git a/GHC/IO/Encoding/Types.hs b/GHC/IO/Encoding/Types.hs new file mode 100644 --- /dev/null +++ b/GHC/IO/Encoding/Types.hs @@ -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) + } diff --git a/GHC/IO/Encoding/UTF16.hs b/GHC/IO/Encoding/UTF16.hs new file mode 100644 --- /dev/null +++ b/GHC/IO/Encoding/UTF16.hs @@ -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 #-} diff --git a/GHC/IO/Encoding/UTF32.hs b/GHC/IO/Encoding/UTF32.hs new file mode 100644 --- /dev/null +++ b/GHC/IO/Encoding/UTF32.hs @@ -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 #-} diff --git a/GHC/IO/Encoding/UTF8.hs b/GHC/IO/Encoding/UTF8.hs new file mode 100644 --- /dev/null +++ b/GHC/IO/Encoding/UTF8.hs @@ -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 diff --git a/GHC/IO/Exception.hs b/GHC/IO/Exception.hs new file mode 100644 --- /dev/null +++ b/GHC/IO/Exception.hs @@ -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 "<>" + +----- + +-- |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 /= '|' diff --git a/GHC/IO/Exception.hs-boot b/GHC/IO/Exception.hs-boot new file mode 100644 --- /dev/null +++ b/GHC/IO/Exception.hs-boot @@ -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 diff --git a/GHC/IO/FD.hs b/GHC/IO/FD.hs new file mode 100644 --- /dev/null +++ b/GHC/IO/FD.hs @@ -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 diff --git a/GHC/IO/Handle.hs b/GHC/IO/Handle.hs new file mode 100644 --- /dev/null +++ b/GHC/IO/Handle.hs @@ -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 diff --git a/GHC/IO/Handle.hs-boot b/GHC/IO/Handle.hs-boot new file mode 100644 --- /dev/null +++ b/GHC/IO/Handle.hs-boot @@ -0,0 +1,8 @@ +{-# OPTIONS_GHC -XNoImplicitPrelude #-} + +module GHC.IO.Handle where + +import GHC.IO +import GHC.IO.Handle.Types + +hFlush :: Handle -> IO () diff --git a/GHC/IO/Handle/FD.hs b/GHC/IO/Handle/FD.hs new file mode 100644 --- /dev/null +++ b/GHC/IO/Handle/FD.hs @@ -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 "" 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 "" 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 "" 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 = "" + 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 diff --git a/GHC/IO/Handle/FD.hs-boot b/GHC/IO/Handle/FD.hs-boot new file mode 100644 --- /dev/null +++ b/GHC/IO/Handle/FD.hs-boot @@ -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 diff --git a/GHC/IO/Handle/Internals.hs b/GHC/IO/Handle/Internals.hs new file mode 100644 --- /dev/null +++ b/GHC/IO/Handle/Internals.hs @@ -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' diff --git a/GHC/IO/Handle/Text.hs b/GHC/IO/Handle/Text.hs new file mode 100644 --- /dev/null +++ b/GHC/IO/Handle/Text.hs @@ -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) diff --git a/GHC/IO/Handle/Types.hs b/GHC/IO/Handle/Types.hs new file mode 100644 --- /dev/null +++ b/GHC/IO/Handle/Types.hs @@ -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 "}" diff --git a/GHC/IO/IOMode.hs b/GHC/IO/IOMode.hs new file mode 100644 --- /dev/null +++ b/GHC/IO/IOMode.hs @@ -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) diff --git a/GHC/IOArray.hs b/GHC/IOArray.hs new file mode 100644 --- /dev/null +++ b/GHC/IOArray.hs @@ -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 diff --git a/GHC/IOBase.hs b/GHC/IOBase.hs new file mode 100644 --- /dev/null +++ b/GHC/IOBase.hs @@ -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 diff --git a/GHC/IOBase.lhs b/GHC/IOBase.lhs deleted file mode 100644 --- a/GHC/IOBase.lhs +++ /dev/null @@ -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 "<>" - ------ - --- |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} - diff --git a/GHC/IORef.hs b/GHC/IORef.hs new file mode 100644 --- /dev/null +++ b/GHC/IORef.hs @@ -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 + diff --git a/GHC/Int.hs b/GHC/Int.hs --- a/GHC/Int.hs +++ b/GHC/Int.hs @@ -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 diff --git a/GHC/List.lhs b/GHC/List.lhs --- a/GHC/List.lhs +++ b/GHC/List.lhs @@ -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] = [] diff --git a/GHC/MVar.hs b/GHC/MVar.hs new file mode 100644 --- /dev/null +++ b/GHC/MVar.hs @@ -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, () #) } + diff --git a/GHC/Num.lhs b/GHC/Num.lhs --- a/GHC/Num.lhs +++ b/GHC/Num.lhs @@ -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 diff --git a/GHC/PArr.hs b/GHC/PArr.hs --- a/GHC/PArr.hs +++ b/GHC/PArr.hs @@ -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 diff --git a/GHC/Pack.lhs b/GHC/Pack.lhs --- a/GHC/Pack.lhs +++ b/GHC/Pack.lhs @@ -35,7 +35,6 @@ where import GHC.Base -import GHC.Err ( error ) import GHC.List ( length ) import GHC.ST import GHC.Num diff --git a/GHC/Ptr.lhs b/GHC/Ptr.lhs --- a/GHC/Ptr.lhs +++ b/GHC/Ptr.lhs @@ -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} diff --git a/GHC/Real.lhs b/GHC/Real.lhs --- a/GHC/Real.lhs +++ b/GHC/Real.lhs @@ -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)] diff --git a/GHC/Show.lhs b/GHC/Show.lhs --- a/GHC/Show.lhs +++ b/GHC/Show.lhs @@ -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#)) diff --git a/GHC/Show.lhs-boot b/GHC/Show.lhs-boot new file mode 100644 --- /dev/null +++ b/GHC/Show.lhs-boot @@ -0,0 +1,10 @@ +\begin{code} +{-# OPTIONS_GHC -XNoImplicitPrelude #-} + +module GHC.Show (showSignedInt) where + +import GHC.Types + +showSignedInt :: Int -> Int -> [Char] -> [Char] +\end{code} + diff --git a/GHC/Stable.lhs b/GHC/Stable.lhs --- a/GHC/Stable.lhs +++ b/GHC/Stable.lhs @@ -27,7 +27,7 @@ import GHC.Ptr import GHC.Base -import GHC.IOBase +-- import GHC.IO ----------------------------------------------------------------------------- -- Stable Pointers diff --git a/GHC/Storable.lhs b/GHC/Storable.lhs --- a/GHC/Storable.lhs +++ b/GHC/Storable.lhs @@ -55,7 +55,6 @@ import GHC.Int import GHC.Word import GHC.Ptr -import GHC.IOBase import GHC.Base \end{code} diff --git a/GHC/TopHandler.lhs b/GHC/TopHandler.lhs --- a/GHC/TopHandler.lhs +++ b/GHC/TopHandler.lhs @@ -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 diff --git a/GHC/Weak.lhs b/GHC/Weak.lhs --- a/GHC/Weak.lhs +++ b/GHC/Weak.lhs @@ -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' diff --git a/GHC/Word.hs b/GHC/Word.hs --- a/GHC/Word.hs +++ b/GHC/Word.hs @@ -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 diff --git a/Prelude.hs b/Prelude.hs --- a/Prelude.hs +++ b/Prelude.hs @@ -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__ */ diff --git a/Prelude.hs-boot b/Prelude.hs-boot deleted file mode 100644 --- a/Prelude.hs-boot +++ /dev/null @@ -1,7 +0,0 @@ -{-# OPTIONS_GHC -XNoImplicitPrelude #-} - -module Prelude where - -import GHC.IOBase - -catch :: IO a -> (IOError -> IO a) -> IO a diff --git a/System/CPUTime.hsc b/System/CPUTime.hsc --- a/System/CPUTime.hsc +++ b/System/CPUTime.hsc @@ -34,9 +34,44 @@ import Foreign import Foreign.C -#include "HsBase.h" +#include "HsBaseConfig.h" + +-- For _SC_CLK_TCK +#if HAVE_UNISTD_H +#include #endif +-- For struct rusage +#if !defined(mingw32_HOST_OS) && !defined(irix_HOST_OS) +# if HAVE_SYS_RESOURCE_H +# include +# endif +#endif + +-- For FILETIME etc. on Windows +#if HAVE_WINDOWS_H +#include +#endif + +-- for CLK_TCK +#if HAVE_TIME_H +#include +#endif + +-- for struct tms +#if HAVE_SYS_TIMES_H +#include +#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. diff --git a/System/Environment.hs b/System/Environment.hs --- a/System/Environment.hs +++ b/System/Environment.hs @@ -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 () diff --git a/System/Exit.hs b/System/Exit.hs --- a/System/Exit.hs +++ b/System/Exit.hs @@ -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__ */ diff --git a/System/IO.hs b/System/IO.hs --- a/System/IO.hs +++ b/System/IO.hs @@ -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 diff --git a/System/IO/Error.hs b/System/IO/Error.hs --- a/System/IO/Error.hs +++ b/System/IO/Error.hs @@ -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__ */ diff --git a/System/IO/Unsafe.hs b/System/IO/Unsafe.hs --- a/System/IO/Unsafe.hs +++ b/System/IO/Unsafe.hs @@ -20,7 +20,7 @@ ) where #ifdef __GLASGOW_HASKELL__ -import GHC.IOBase (unsafePerformIO, unsafeInterleaveIO) +import GHC.IO (unsafePerformIO, unsafeInterleaveIO) #endif #ifdef __HUGS__ diff --git a/System/Mem/StableName.hs b/System/Mem/StableName.hs --- a/System/Mem/StableName.hs +++ b/System/Mem/StableName.hs @@ -38,7 +38,7 @@ #endif #ifdef __GLASGOW_HASKELL__ -import GHC.IOBase ( IO(..) ) +import GHC.IO ( IO(..) ) import GHC.Base ( Int(..), StableName#, makeStableName# , eqStableName#, stableNameToInt# ) diff --git a/System/Mem/Weak.hs b/System/Mem/Weak.hs --- a/System/Mem/Weak.hs +++ b/System/Mem/Weak.hs @@ -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 diff --git a/System/Posix/Internals.hs b/System/Posix/Internals.hs --- a/System/Posix/Internals.hs +++ b/System/Posix/Internals.hs @@ -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 diff --git a/System/Posix/Types.hs b/System/Posix/Types.hs --- a/System/Posix/Types.hs +++ b/System/Posix/Types.hs @@ -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 diff --git a/System/Timeout.hs b/System/Timeout.hs --- a/System/Timeout.hs +++ b/System/Timeout.hs @@ -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 diff --git a/Text/ParserCombinators/ReadP.hs b/Text/ParserCombinators/ReadP.hs --- a/Text/ParserCombinators/ReadP.hs +++ b/Text/ParserCombinators/ReadP.hs @@ -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@. diff --git a/Text/Printf.hs b/Text/Printf.hs --- a/Text/Printf.hs +++ b/Text/Printf.hs @@ -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 diff --git a/Text/Read/Lex.hs b/Text/Read/Lex.hs --- a/Text/Read/Lex.hs +++ b/Text/Read/Lex.hs @@ -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 []) diff --git a/aclocal.m4 b/aclocal.m4 --- a/aclocal.m4 +++ b/aclocal.m4 @@ -135,15 +135,17 @@ # include #endif +#include + 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 -#include -#include -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 +]) diff --git a/base.cabal b/base.cabal --- a/base.cabal +++ b/base.cabal @@ -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) diff --git a/cbits/PrelIOUtils.c b/cbits/PrelIOUtils.c --- a/cbits/PrelIOUtils.c +++ b/cbits/PrelIOUtils.c @@ -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 +char *localeEncoding (void) +{ + return nl_langinfo(CODESET); +} +#endif + #endif /* __GLASGOW_HASKELL__ */ diff --git a/cbits/dirUtils.c b/cbits/dirUtils.c deleted file mode 100644 --- a/cbits/dirUtils.c +++ /dev/null @@ -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 -#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 -} diff --git a/cbits/iconv.c b/cbits/iconv.c new file mode 100644 --- /dev/null +++ b/cbits/iconv.c @@ -0,0 +1,25 @@ +#ifndef __MINGW32__ + +#include +#include + +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 diff --git a/cbits/primFloat.c b/cbits/primFloat.c new file mode 100644 --- /dev/null +++ b/cbits/primFloat.c @@ -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 */ diff --git a/configure b/configure --- a/configure +++ b/configure @@ -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 #endif +#include + 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 #endif +#include + 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 #endif +#include + 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 #endif +#include + 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 #endif +#include + 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 #endif +#include + 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 #endif +#include + 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 #endif +#include + 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 #endif +#include + 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 #endif +#include + 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 #endif +#include + 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 #endif +#include + 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 #endif +#include + 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 #endif +#include + 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 #endif +#include + 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 #endif +#include + 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 #endif +#include + 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 #endif +#include + 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 #endif +#include + 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 #endif +#include + 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 #endif +#include + 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 #endif +#include + 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 #endif +#include + 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 #endif +#include + 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 #endif +#include + 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 #endif +#include + 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 #endif +#include + 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 #endif +#include + 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 #endif +#include + 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 #endif +#include + 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 #endif +#include + 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 #endif +#include + 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 #endif +#include + 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 #endif +#include + 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 #endif +#include + 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 #endif +#include + 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 #endif +#include + 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 -#include -#include -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 +#include - /* 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 >$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 diff --git a/configure.ac b/configure.ac --- a/configure.ac +++ b/configure.ac @@ -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 ], [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 +#include + ], + [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 diff --git a/include/HsBase.h b/include/HsBase.h --- a/include/HsBase.h +++ b/include/HsBase.h @@ -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 #endif -#if HAVE_DIRENT_H -#include -#endif #if HAVE_UTIME_H #include #endif @@ -125,7 +126,6 @@ #if HAVE_VFORK_H #include #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__ */ diff --git a/include/HsBaseConfig.h b/include/HsBaseConfig.h --- a/include/HsBaseConfig.h +++ b/include/HsBaseConfig.h @@ -307,9 +307,6 @@ /* Define to 1 if you have the header file. */ #define HAVE_CTYPE_H 1 -/* Define to 1 if you have the header file. */ -#define HAVE_DIRENT_H 1 - /* Define to 1 if you have the 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 header file. */ +#define HAVE_LANGINFO_H 1 + /* Define to 1 if you have the header file. */ #define HAVE_LIMITS_H 1 @@ -343,9 +343,6 @@ /* Define to 1 if you have the 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 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 */ diff --git a/include/dirUtils.h b/include/dirUtils.h deleted file mode 100644 --- a/include/dirUtils.h +++ /dev/null @@ -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__ */