packages feed

base 4.3.1.0 → 4.4.0.0

raw patch · 223 files changed

+30837/−15970 lines, 223 files

Files

Control/Applicative.hs view
@@ -1,3 +1,6 @@+{-# LANGUAGE Trustworthy #-}+{-# LANGUAGE CPP #-}+ ----------------------------------------------------------------------------- -- | -- Module      :  Control.Applicative@@ -9,39 +12,49 @@ -- Portability :  portable -- -- This module describes a structure intermediate between a functor and--- a monad: it provides pure expressions and sequencing, but no binding.--- (Technically, a strong lax monoidal functor.)  For more details, see--- /Applicative Programming with Effects/,--- by Conor McBride and Ross Paterson, online at--- <http://www.soi.city.ac.uk/~ross/papers/Applicative.html>.+-- a monad (technically, a strong lax monoidal functor).  Compared with+-- monads, this interface lacks the full power of the binding operation+-- '>>=', but --+-- * it has more instances.+--+-- * it is sufficient for many uses, e.g. context-free parsing, or the+--   'Data.Traversable.Traversable' class.+--+-- * instances can perform analysis of computations before they are+--   executed, and thus produce shared optimizations.+-- -- This interface was introduced for parsers by Niklas R&#xF6;jemo, because -- it admits more sharing than the monadic interface.  The names here are--- mostly based on recent parsing work by Doaitse Swierstra.+-- mostly based on parsing work by Doaitse Swierstra. ----- This class is also useful with instances of the--- 'Data.Traversable.Traversable' class.+-- For more details, see /Applicative Programming with Effects/,+-- by Conor McBride and Ross Paterson, online at+-- <http://www.soi.city.ac.uk/~ross/papers/Applicative.html>.  module Control.Applicative (-        -- * Applicative functors-        Applicative(..),-        -- * Alternatives-        Alternative(..),-        -- * Instances-        Const(..), WrappedMonad(..), WrappedArrow(..), ZipList(..),-        -- * Utility functions-        (<$>), (<$), (<**>),-        liftA, liftA2, liftA3,-        optional,-        ) where+    -- * Applicative functors+    Applicative(..),+    -- * Alternatives+    Alternative(..),+    -- * Instances+    Const(..), WrappedMonad(..), WrappedArrow(..), ZipList(..),+    -- * Utility functions+    (<$>), (<$), (<**>),+    liftA, liftA2, liftA3,+    optional,+    ) where  import Prelude hiding (id,(.))  import Control.Category-import Control.Arrow-        (Arrow(arr, (&&&)), ArrowZero(zeroArrow), ArrowPlus((<+>)))+import Control.Arrow (Arrow(arr, (&&&)), ArrowZero(zeroArrow), ArrowPlus((<+>))) import Control.Monad (liftM, ap, MonadPlus(..)) import Control.Monad.Instances ()+#ifndef __NHC__+import Control.Monad.ST.Safe (ST)+import qualified Control.Monad.ST.Lazy.Safe as Lazy (ST)+#endif import Data.Functor ((<$>), (<$)) import Data.Monoid (Monoid(..)) @@ -52,10 +65,15 @@ infixl 3 <|> infixl 4 <*>, <*, *>, <**> --- | A functor with application.+-- | A functor with application, providing operations to ----- Instances should satisfy the following laws:+-- * embed pure expressions ('pure'), and --+-- * sequence computations and combine their results ('<*>').+--+-- A minimal complete definition must include implementations of these+-- functions satisfying the following laws:+-- -- [/identity/] --      @'pure' 'id' '<*>' v = v@ --@@ -68,87 +86,102 @@ -- [/interchange/] --      @u '<*>' 'pure' y = 'pure' ('$' y) '<*>' u@ ----- [/ignore left value/]---      @u '*>' v = 'pure' ('const' 'id') '<*>' u '<*>' v@+-- The other methods have the following default definitions, which may+-- be overridden with equivalent specialized implementations: ----- [/ignore right value/]---      @u '<*' v = 'pure' 'const' '<*>' u '<*>' v@+-- @+--      u '*>' v = 'pure' ('const' 'id') '<*>' u '<*>' v+--      u '<*' v = 'pure' 'const' '<*>' u '<*>' v+-- @ ----- The 'Functor' instance should satisfy+-- As a consequence of these laws, the 'Functor' instance for @f@ will satisfy -- -- @ --      'fmap' f x = 'pure' f '<*>' x -- @ ----- If @f@ is also a 'Monad', define @'pure' = 'return'@ and @('<*>') = 'ap'@.------ Minimal complete definition: 'pure' and '<*>'.+-- If @f@ is also a 'Monad', it should satisfy @'pure' = 'return'@ and+-- @('<*>') = 'ap'@ (which implies that 'pure' and '<*>' satisfy the+-- applicative functor laws).  class Functor f => Applicative f where-        -- | Lift a value.-        pure :: a -> f a+    -- | Lift a value.+    pure :: a -> f a -        -- | Sequential application.-        (<*>) :: f (a -> b) -> f a -> f b+    -- | 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 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+    -- | 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:+-- If defined, '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+    -- | 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+    -- | 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+    -- | 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-        pure = return-        (<*>) = ap+    pure = return+    (<*>) = ap  instance Alternative Maybe where-        empty = Nothing-        Nothing <|> p = p-        Just x <|> _ = Just x+    empty = Nothing+    Nothing <|> p = p+    Just x <|> _ = Just x  instance Applicative [] where-        pure = return-        (<*>) = ap+    pure = return+    (<*>) = ap  instance Alternative [] where-        empty = []-        (<|>) = (++)+    empty = []+    (<|>) = (++)  instance Applicative IO where-        pure = return-        (<*>) = ap+    pure = return+    (<*>) = ap +#ifndef __NHC__+instance Applicative (ST s) where+    pure = return+    (<*>) = ap++instance Applicative (Lazy.ST s) where+    pure = return+    (<*>) = ap+#endif+ #ifdef __GLASGOW_HASKELL__ instance Applicative STM where     pure = return@@ -160,54 +193,54 @@ #endif  instance Applicative ((->) a) where-        pure = const-        (<*>) f g x = f x (g x)+    pure = const+    (<*>) f g x = f x (g x)  instance Monoid a => Applicative ((,) a) where-        pure x = (mempty, x)-        (u, f) <*> (v, x) = (u `mappend` v, f x)+    pure x = (mempty, x)+    (u, f) <*> (v, x) = (u `mappend` v, f x)  instance Applicative (Either e) where-        pure          = Right-        Left  e <*> _ = Left e-        Right f <*> r = fmap f r+    pure          = Right+    Left  e <*> _ = Left e+    Right f <*> r = fmap f r  -- new instances  newtype Const a b = Const { getConst :: a }  instance Functor (Const m) where-        fmap _ (Const v) = Const v+    fmap _ (Const v) = Const v  instance Monoid m => Applicative (Const m) where-        pure _ = Const mempty-        Const f <*> Const v = Const (f `mappend` v)+    pure _ = Const mempty+    Const f <*> Const v = Const (f `mappend` v)  newtype WrappedMonad m a = WrapMonad { unwrapMonad :: m a }  instance Monad m => Functor (WrappedMonad m) where-        fmap f (WrapMonad v) = WrapMonad (liftM f v)+    fmap f (WrapMonad v) = WrapMonad (liftM f v)  instance Monad m => Applicative (WrappedMonad m) where-        pure = WrapMonad . return-        WrapMonad f <*> WrapMonad v = WrapMonad (f `ap` v)+    pure = WrapMonad . return+    WrapMonad f <*> WrapMonad v = WrapMonad (f `ap` v)  instance MonadPlus m => Alternative (WrappedMonad m) where-        empty = WrapMonad mzero-        WrapMonad u <|> WrapMonad v = WrapMonad (u `mplus` v)+    empty = WrapMonad mzero+    WrapMonad u <|> WrapMonad v = WrapMonad (u `mplus` v)  newtype WrappedArrow a b c = WrapArrow { unwrapArrow :: a b c }  instance Arrow a => Functor (WrappedArrow a b) where-        fmap f (WrapArrow a) = WrapArrow (a >>> arr f)+    fmap f (WrapArrow a) = WrapArrow (a >>> arr f)  instance Arrow a => Applicative (WrappedArrow a b) where-        pure x = WrapArrow (arr (const x))-        WrapArrow f <*> WrapArrow v = WrapArrow (f &&& v >>> arr (uncurry id))+    pure x = WrapArrow (arr (const x))+    WrapArrow f <*> WrapArrow v = WrapArrow (f &&& v >>> arr (uncurry id))  instance (ArrowZero a, ArrowPlus a) => Alternative (WrappedArrow a b) where-        empty = WrapArrow zeroArrow-        WrapArrow u <|> WrapArrow v = WrapArrow (u <+> v)+    empty = WrapArrow zeroArrow+    WrapArrow u <|> WrapArrow v = WrapArrow (u <+> v)  -- | Lists, but with an 'Applicative' functor based on zipping, so that --@@ -216,11 +249,11 @@ newtype ZipList a = ZipList { getZipList :: [a] }  instance Functor ZipList where-        fmap f (ZipList xs) = ZipList (map f xs)+    fmap f (ZipList xs) = ZipList (map f xs)  instance Applicative ZipList where-        pure x = ZipList (repeat x)-        ZipList fs <*> ZipList xs = ZipList (zipWith id fs xs)+    pure x = ZipList (repeat x)+    ZipList fs <*> ZipList xs = ZipList (zipWith id fs xs)  -- extra functions
Control/Arrow.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE Trustworthy #-} ----------------------------------------------------------------------------- -- | -- Module      :  Control.Arrow@@ -19,24 +20,23 @@ -- <http://www.haskell.org/arrows/>.  module Control.Arrow (-                -- * Arrows-                Arrow(..), Kleisli(..),-                -- ** Derived combinators-                returnA,-                (^>>), (>>^),-                -- ** Right-to-left variants-                (<<^), (^<<),-                -- * Monoid operations-                ArrowZero(..), ArrowPlus(..),-                -- * Conditionals-                ArrowChoice(..),-                -- * Arrow application-                ArrowApply(..), ArrowMonad(..), leftApp,-                -- * Feedback-                ArrowLoop(..),--                (>>>), (<<<) -- reexported-        ) where+    -- * Arrows+    Arrow(..), Kleisli(..),+    -- ** Derived combinators+    returnA,+    (^>>), (>>^),+    (>>>), (<<<), -- reexported+    -- ** Right-to-left variants+    (<<^), (^<<),+    -- * Monoid operations+    ArrowZero(..), ArrowPlus(..),+    -- * Conditionals+    ArrowChoice(..),+    -- * Arrow application+    ArrowApply(..), ArrowMonad(..), leftApp,+    -- * Feedback+    ArrowLoop(..)+    ) where  import Prelude hiding (id,(.)) @@ -61,37 +61,38 @@  class Category a => Arrow a where -        -- | Lift a function to an arrow.-        arr :: (b -> c) -> a b c+    -- | Lift a function to an arrow.+    arr :: (b -> c) -> a b c -        -- | Send the first component of the input through the argument-        --   arrow, and copy the rest unchanged to the output.-        first :: a b c -> a (b,d) (c,d)+    -- | Send the first component of the input through the argument+    --   arrow, and copy the rest unchanged to the output.+    first :: a b c -> a (b,d) (c,d) -        -- | A mirror image of 'first'.-        ---        --   The default definition may be overridden with a more efficient-        --   version if desired.-        second :: a b c -> a (d,b) (d,c)-        second f = arr swap >>> first f >>> arr swap-                        where   swap :: (x,y) -> (y,x)-                                swap ~(x,y) = (y,x)+    -- | A mirror image of 'first'.+    --+    --   The default definition may be overridden with a more efficient+    --   version if desired.+    second :: a b c -> a (d,b) (d,c)+    second f = arr swap >>> first f >>> arr swap+      where+        swap :: (x,y) -> (y,x)+        swap ~(x,y) = (y,x) -        -- | Split the input between the two argument arrows and combine-        --   their output.  Note that this is in general not a functor.-        ---        --   The default definition may be overridden with a more efficient-        --   version if desired.-        (***) :: a b c -> a b' c' -> a (b,b') (c,c')-        f *** g = first f >>> second g+    -- | Split the input between the two argument arrows and combine+    --   their output.  Note that this is in general not a functor.+    --+    --   The default definition may be overridden with a more efficient+    --   version if desired.+    (***) :: a b c -> a b' c' -> a (b,b') (c,c')+    f *** g = first f >>> second g -        -- | Fanout: send the input to both argument arrows and combine-        --   their output.-        ---        --   The default definition may be overridden with a more efficient-        --   version if desired.-        (&&&) :: a b c -> a b c' -> a b (c,c')-        f &&& g = arr (\b -> (b,b)) >>> f *** g+    -- | Fanout: send the input to both argument arrows and combine+    --   their output.+    --+    --   The default definition may be overridden with a more efficient+    --   version if desired.+    (&&&) :: a b c -> a b c' -> a b (c,c')+    f &&& g = arr (\b -> (b,b)) >>> f *** g  {-# RULES "compose/arr"   forall f g .@@ -113,25 +114,25 @@ -- Ordinary functions are arrows.  instance Arrow (->) where-        arr f = f-        first f = f *** id-        second f = id *** f---      (f *** g) ~(x,y) = (f x, g y)---      sorry, although the above defn is fully H'98, nhc98 can't parse it.-        (***) f g ~(x,y) = (f x, g y)+    arr f = f+    first f = f *** id+    second f = id *** f+--  (f *** g) ~(x,y) = (f x, g y)+--  sorry, although the above defn is fully H'98, nhc98 can't parse it.+    (***) f g ~(x,y) = (f x, g y)  -- | Kleisli arrows of a monad.  newtype Kleisli m a b = Kleisli { runKleisli :: a -> m b }  instance Monad m => Category (Kleisli m) where-        id = Kleisli return-        (Kleisli f) . (Kleisli g) = Kleisli (\b -> g b >>= f)+    id = Kleisli return+    (Kleisli f) . (Kleisli g) = Kleisli (\b -> g b >>= f)  instance Monad m => Arrow (Kleisli m) where-        arr f = Kleisli (return . f)-        first (Kleisli f) = Kleisli (\ ~(b,d) -> f b >>= \c -> return (c,d))-        second (Kleisli f) = Kleisli (\ ~(d,b) -> f b >>= \c -> return (d,c))+    arr f = Kleisli (return . f)+    first (Kleisli f) = Kleisli (\ ~(b,d) -> f b >>= \c -> return (c,d))+    second (Kleisli f) = Kleisli (\ ~(d,b) -> f b >>= \c -> return (d,c))  -- | The identity arrow, which plays the role of 'return' in arrow notation. @@ -155,16 +156,16 @@ f ^<< a = arr f <<< a  class Arrow a => ArrowZero a where-        zeroArrow :: a b c+    zeroArrow :: a b c  instance MonadPlus m => ArrowZero (Kleisli m) where-        zeroArrow = Kleisli (\_ -> mzero)+    zeroArrow = Kleisli (\_ -> mzero)  class ArrowZero a => ArrowPlus a where-        (<+>) :: a b c -> a b c -> a b c+    (<+>) :: a b c -> a b c -> a b c  instance MonadPlus m => ArrowPlus (Kleisli m) where-        Kleisli f <+> Kleisli g = Kleisli (\x -> f x `mplus` g x)+    Kleisli f <+> Kleisli g = Kleisli (\x -> f x `mplus` g x)  -- | Choice, for arrows that support it.  This class underlies the --   @if@ and @case@ constructs in arrow notation.@@ -173,38 +174,40 @@  class Arrow a => ArrowChoice a where -        -- | Feed marked inputs through the argument arrow, passing the-        --   rest through unchanged to the output.-        left :: a b c -> a (Either b d) (Either c d)+    -- | Feed marked inputs through the argument arrow, passing the+    --   rest through unchanged to the output.+    left :: a b c -> a (Either b d) (Either c d) -        -- | A mirror image of 'left'.-        ---        --   The default definition may be overridden with a more efficient-        --   version if desired.-        right :: a b c -> a (Either d b) (Either d c)-        right f = arr mirror >>> left f >>> arr mirror-                        where   mirror :: Either x y -> Either y x-                                mirror (Left x) = Right x-                                mirror (Right y) = Left y+    -- | A mirror image of 'left'.+    --+    --   The default definition may be overridden with a more efficient+    --   version if desired.+    right :: a b c -> a (Either d b) (Either d c)+    right f = arr mirror >>> left f >>> arr mirror+      where+        mirror :: Either x y -> Either y x+        mirror (Left x) = Right x+        mirror (Right y) = Left y -        -- | Split the input between the two argument arrows, retagging-        --   and merging their outputs.-        --   Note that this is in general not a functor.-        ---        --   The default definition may be overridden with a more efficient-        --   version if desired.-        (+++) :: a b c -> a b' c' -> a (Either b b') (Either c c')-        f +++ g = left f >>> right g+    -- | Split the input between the two argument arrows, retagging+    --   and merging their outputs.+    --   Note that this is in general not a functor.+    --+    --   The default definition may be overridden with a more efficient+    --   version if desired.+    (+++) :: a b c -> a b' c' -> a (Either b b') (Either c c')+    f +++ g = left f >>> right g -        -- | Fanin: Split the input between the two argument arrows and-        --   merge their outputs.-        ---        --   The default definition may be overridden with a more efficient-        --   version if desired.-        (|||) :: a b d -> a c d -> a (Either b c) d-        f ||| g = f +++ g >>> arr untag-                        where   untag (Left x) = x-                                untag (Right y) = y+    -- | Fanin: Split the input between the two argument arrows and+    --   merge their outputs.+    --+    --   The default definition may be overridden with a more efficient+    --   version if desired.+    (|||) :: a b d -> a c d -> a (Either b c) d+    f ||| g = f +++ g >>> arr untag+      where+        untag (Left x) = x+        untag (Right y) = y  {-# RULES "left/arr"      forall f .@@ -222,56 +225,55 @@  #-}  instance ArrowChoice (->) where-        left f = f +++ id-        right f = id +++ f-        f +++ g = (Left . f) ||| (Right . g)-        (|||) = either+    left f = f +++ id+    right f = id +++ f+    f +++ g = (Left . f) ||| (Right . g)+    (|||) = either  instance Monad m => ArrowChoice (Kleisli m) where-        left f = f +++ arr id-        right f = arr id +++ f-        f +++ g = (f >>> arr Left) ||| (g >>> arr Right)-        Kleisli f ||| Kleisli g = Kleisli (either f g)+    left f = f +++ arr id+    right f = arr id +++ f+    f +++ g = (f >>> arr Left) ||| (g >>> arr Right)+    Kleisli f ||| Kleisli g = Kleisli (either f g)  -- | Some arrows allow application of arrow inputs to other inputs.  class Arrow a => ArrowApply a where-        app :: a (a b c, b) c+    app :: a (a b c, b) c  instance ArrowApply (->) where-        app (f,x) = f x+    app (f,x) = f x  instance Monad m => ArrowApply (Kleisli m) where-        app = Kleisli (\(Kleisli f, x) -> f x)+    app = Kleisli (\(Kleisli f, x) -> f x)  -- | The 'ArrowApply' class is equivalent to 'Monad': any monad gives rise --   to a 'Kleisli' arrow, and any instance of 'ArrowApply' defines a monad. -newtype ArrowApply a => ArrowMonad a b = ArrowMonad (a () b)+newtype ArrowMonad a b = ArrowMonad (a () b)  instance ArrowApply a => Monad (ArrowMonad a) where-        return x = ArrowMonad (arr (\_ -> x))-        ArrowMonad m >>= f = ArrowMonad (m >>>-                        arr (\x -> let ArrowMonad h = f x in (h, ())) >>>-                        app)+    return x = ArrowMonad (arr (\_ -> x))+    ArrowMonad m >>= f = ArrowMonad $+        m >>> arr (\x -> let ArrowMonad h = f x in (h, ())) >>> app  -- | Any instance of 'ArrowApply' can be made into an instance of --   'ArrowChoice' by defining 'left' = 'leftApp'.  leftApp :: ArrowApply a => a b c -> a (Either b d) (Either c d) leftApp f = arr ((\b -> (arr (\() -> b) >>> f >>> arr Left, ())) |||-                 (\d -> (arr (\() -> d) >>> arr Right, ()))) >>> app+             (\d -> (arr (\() -> d) >>> arr Right, ()))) >>> app  -- | The 'loop' operator expresses computations in which an output value is --   fed back as input, even though the computation occurs only once. --   It underlies the @rec@ value recursion construct in arrow notation.  class Arrow a => ArrowLoop a where-        loop :: a (b,d) (c,d) -> a b c+    loop :: a (b,d) (c,d) -> a b c  instance ArrowLoop (->) where-        loop f b = let (c,d) = f (b,d) in c+    loop f b = let (c,d) = f (b,d) in c  instance MonadFix m => ArrowLoop (Kleisli m) where-        loop (Kleisli f) = Kleisli (liftM fst . mfix . f')-                where   f' x y = f (x, snd y)+    loop (Kleisli f) = Kleisli (liftM fst . mfix . f')+      where f' x y = f (x, snd y)
Control/Category.hs view
@@ -1,3 +1,6 @@+{-# LANGUAGE Trustworthy #-}+{-# LANGUAGE CPP #-}+ ----------------------------------------------------------------------------- -- | -- Module      :  Control.Category@@ -20,11 +23,11 @@ -- | A class for categories. --   id and (.) must form a monoid. class Category cat where-        -- | the identity morphism-        id :: cat a a+    -- | the identity morphism+    id :: cat a a -        -- | morphism composition-        (.) :: cat b c -> cat a b -> cat a c+    -- | morphism composition+    (.) :: cat b c -> cat a b -> cat a c  {-# RULES "identity/left" forall p .@@ -36,10 +39,10 @@  #-}  instance Category (->) where-        id = Prelude.id+    id = Prelude.id #ifndef __HADDOCK__ -- Haddock 1.x cannot parse this:-        (.) = (Prelude..)+    (.) = (Prelude..) #endif  -- | Right-to-left composition
Control/Concurrent.hs view
@@ -1,4 +1,12 @@+{-# LANGUAGE Trustworthy #-}+{-# LANGUAGE CPP+           , ForeignFunctionInterface+           , MagicHash+           , UnboxedTuples+           , ScopedTypeVariables+  #-} {-# OPTIONS_GHC -fno-warn-unused-imports #-}+ ----------------------------------------------------------------------------- -- | -- Module      :  Control.Concurrent@@ -28,11 +36,17 @@          forkIO, #ifdef __GLASGOW_HASKELL__-        forkIOUnmasked,+        forkIOWithUnmask,         killThread,         throwTo, #endif +        -- ** Threads with affinity+        forkOn,+        forkOnWithUnmask,+        getNumCapabilities,+        threadCapability,+         -- * Scheduling          -- $conc_scheduling     @@ -71,7 +85,7 @@         forkOS,         isCurrentThreadBound,         runInBoundThread,-        runInUnboundThread+        runInUnboundThread, #endif          -- * GHC's implementation of concurrency@@ -90,6 +104,10 @@         -- ** Pre-emption          -- $preemption++        -- * Deprecated functions+        forkIOUnmasked+     ) where  import Prelude@@ -98,8 +116,7 @@  #ifdef __GLASGOW_HASKELL__ import GHC.Exception-import GHC.Conc         ( ThreadId(..), myThreadId, killThread, yield,-                          threadDelay, forkIO, forkIOUnmasked, childHandler )+import GHC.Conc hiding (threadWaitRead, threadWaitWrite) import qualified GHC.Conc import GHC.IO           ( IO(..), unsafeInterleaveIO, unsafeUnmask ) import GHC.IORef        ( newIORef, readIORef, writeIORef )@@ -406,13 +423,10 @@             else do                 ref <- newIORef undefined                 let action_plus = Exception.try action >>= writeIORef ref-                resultOrException <--                    bracket (newStablePtr action_plus)-                            freeStablePtr-                            (\cEntry -> forkOS_entry_reimported cEntry >> readIORef ref)-                case resultOrException of-                    Left exception -> Exception.throw (exception :: SomeException)-                    Right result -> return result+                bracket (newStablePtr action_plus)+                        freeStablePtr+                        (\cEntry -> forkOS_entry_reimported cEntry >> readIORef ref) >>=+                  unsafeResult     | otherwise = failNonThreaded  {- | @@ -425,23 +439,27 @@ doesn't need it's main thread to be bound and makes /heavy/ use of concurrency (e.g. a web server), might want to wrap it's @main@ action in @runInUnboundThread@.++Note that exceptions which are thrown to the current thread are thrown in turn+to the thread that is executing the given computation. This ensures there's+always a way of killing the forked thread. -} runInUnboundThread :: IO a -> IO a  runInUnboundThread action = do-    bound <- isCurrentThreadBound-    if bound-        then do-            mv <- newEmptyMVar-            b <- blocked-            _ <- mask $ \restore -> forkIO $-              Exception.try (if b then action else restore action) >>=-              putMVar mv-            takeMVar mv >>= \ei -> case ei of-                Left exception -> Exception.throw (exception :: SomeException)-                Right result -> return result-        else action+  bound <- isCurrentThreadBound+  if bound+    then do+      mv <- newEmptyMVar+      mask $ \restore -> do+        tid <- forkIO $ Exception.try (restore action) >>= putMVar mv+        let wait = takeMVar mv `Exception.catch` \(e :: SomeException) ->+                     Exception.throwTo tid e >> wait+        wait >>= unsafeResult+    else action +unsafeResult :: Either SomeException a -> IO a+unsafeResult = either Exception.throwIO return #endif /* __GLASGOW_HASKELL__ */  #ifdef __GLASGOW_HASKELL__@@ -504,7 +522,7 @@ waitFd :: Fd -> CInt -> IO () waitFd fd write = do    throwErrnoIfMinus1_ "fdReady" $-        fdReady (fromIntegral fd) write (fromIntegral iNFINITE) 0+        fdReady (fromIntegral fd) write iNFINITE 0  iNFINITE :: CInt iNFINITE = 0xFFFFFFFF -- urgh
Control/Concurrent/Chan.hs view
@@ -1,3 +1,9 @@+{-# LANGUAGE Trustworthy #-}+{-# LANGUAGE CPP #-}+#ifdef __GLASGOW_HASKELL__+{-# LANGUAGE DeriveDataTypeable, StandaloneDeriving #-}+#endif+ ----------------------------------------------------------------------------- -- | -- Module      :  Control.Concurrent.Chan@@ -46,6 +52,7 @@ data Chan a  = Chan (MVar (Stream a))         (MVar (Stream a))+   deriving Eq  INSTANCE_TYPEABLE1(Chan,chanTc,"Chan") @@ -93,6 +100,9 @@ -- either channel from then on will be available from both.  Hence this creates -- a kind of broadcast channel, where data written by anyone is seen by -- everyone else.+--+-- (Note that a duplicated channel is not equal to its original.+-- So: @fmap (c /=) $ dupChan c@ returns @True@ for all @c@.) dupChan :: Chan a -> IO (Chan a) dupChan (Chan _ writeVar) = do    hole       <- readMVar writeVar
Control/Concurrent/MVar.hs view
@@ -1,4 +1,6 @@-{-# OPTIONS_GHC -XNoImplicitPrelude #-}+{-# LANGUAGE Trustworthy #-}+{-# LANGUAGE CPP, NoImplicitPrelude #-}+ ----------------------------------------------------------------------------- -- | -- Module      :  Control.Concurrent.MVar@@ -9,8 +11,114 @@ -- Stability   :  experimental -- Portability :  non-portable (concurrency) ----- Synchronising variables+-- An @'MVar' t@ is mutable location that is either empty or contains a+-- value of type @t@.  It has two fundamental operations: 'putMVar'+-- which fills an 'MVar' if it is empty and blocks otherwise, and+-- 'takeMVar' which empties an 'MVar' if it is full and blocks+-- otherwise.  They can be used in multiple different ways: --+--  1. As synchronized mutable variables,+--  2. As channels, with 'takeMVar' and 'putMVar' as receive and send, and+--  3. As a binary semaphore @'MVar' ()@, with 'takeMVar' and 'putMVar' as+--     wait and signal.+--+-- They were introduced in the paper "Concurrent Haskell" by Simon+-- Peyton Jones, Andrew Gordon and Sigbjorn Finne, though some details+-- of their implementation have since then changed (in particular, a+-- put on a full MVar used to error, but now merely blocks.)+--+-- * Applicability+--+-- 'MVar's offer more flexibility than 'IORef's, but less flexibility+-- than 'STM'.  They are appropriate for building synchronization+-- primitives and performing simple interthread communication; however+-- they are very simple and susceptible to race conditions, deadlocks or+-- uncaught exceptions.  Do not use them if you need perform larger+-- atomic operations such as reading from multiple variables: use 'STM'+-- instead.+--+-- In particular, the "bigger" functions in this module ('readMVar',+-- 'swapMVar', 'withMVar', 'modifyMVar_' and 'modifyMVar') are simply+-- the composition of a 'takeMVar' followed by a 'putMVar' with+-- exception safety.+-- These only have atomicity guarantees if all other threads+-- perform a 'takeMVar' before a 'putMVar' as well;  otherwise, they may+-- block.+--+-- * Fairness+--+-- No thread can be blocked indefinitely on an 'MVar' unless another+-- thread holds that 'MVar' indefinitely.  One usual implementation of+-- this fairness guarantee is that threads blocked on an 'MVar' are+-- served in a first-in-first-out fashion, but this is not guaranteed+-- in the semantics.+--+-- * Gotchas+--+-- Like many other Haskell data structures, 'MVar's are lazy.  This+-- means that if you place an expensive unevaluated thunk inside an+-- 'MVar', it will be evaluated by the thread that consumes it, not the+-- thread that produced it.  Be sure to 'evaluate' values to be placed+-- in an 'MVar' to the appropriate normal form, or utilize a strict+-- MVar provided by the strict-concurrency package.+--+-- * Ordering+--+-- 'MVar' operations are always observed to take place in the order+-- they are written in the program, regardless of the memory model of+-- the underlying machine.  This is in contrast to 'IORef' operations+-- which may appear out-of-order to another thread in some cases.+--+-- * Example+--+-- Consider the following concurrent data structure, a skip channel.+-- This is a channel for an intermittent source of high bandwidth+-- information (for example, mouse movement events.)  Writing to the+-- channel never blocks, and reading from the channel only returns the+-- most recent value, or blocks if there are no new values.  Multiple+-- readers are supported with a @dupSkipChan@ operation.+--+-- A skip channel is a pair of 'MVar's. The first 'MVar' contains the+-- current value, and a list of semaphores that need to be notified+-- when it changes. The second 'MVar' is a semaphore for this particular+-- reader: it is full if there is a value in the channel that this+-- reader has not read yet, and empty otherwise.+--+-- @+--     data SkipChan a = SkipChan (MVar (a, [MVar ()])) (MVar ())+--+--     newSkipChan :: IO (SkipChan a)+--     newSkipChan = do+--         sem <- newEmptyMVar+--         main <- newMVar (undefined, [sem])+--         return (SkipChan main sem)+--+--     putSkipChan :: SkipChan a -> a -> IO ()+--     putSkipChan (SkipChan main _) v = do+--         (_, sems) <- takeMVar main+--         putMVar main (v, [])+--         mapM_ (\sem -> putMVar sem ()) sems+--+--     getSkipChan :: SkipChan a -> IO a+--     getSkipChan (SkipChan main sem) = do+--         takeMVar sem+--         (v, sems) <- takeMVar main+--         putMVar main (v, sem:sems)+--         return v+--+--     dupSkipChan :: SkipChan a -> IO (SkipChan a)+--     dupSkipChan (SkipChan main _) = do+--         sem <- newEmptyMVar+--         (v, sems) <- takeMVar main+--         putMVar main (v, sem:sems)+--         return (SkipChan main sem)+-- @+--+-- This example was adapted from the original Concurrent Haskell paper.+-- For more examples of 'MVar's being used to build higher-level+-- synchronization primitives, see 'Control.Concurrent.Chan' and+-- 'Control.Concurrent.QSem'.+-- -----------------------------------------------------------------------------  module Control.Concurrent.MVar@@ -56,7 +164,9 @@  {-|   This is a combination of 'takeMVar' and 'putMVar'; ie. it takes the value-  from the 'MVar', puts it back, and also returns it.+  from the 'MVar', puts it back, and also returns it.  This function+  is atomic only if there are no other producers (i.e. threads calling+  'putMVar') for this 'MVar'. -} readMVar :: MVar a -> IO a readMVar m =@@ -67,9 +177,8 @@  {-|   Take a value from an 'MVar', put a new value into the 'MVar' and-  return the value taken. Note that there is a race condition whereby-  another process can put something in the 'MVar' after the take-  happens but before the put does.+  return the value taken. This function is atomic only if there are+  no other producers for this 'MVar'. -} swapMVar :: MVar a -> a -> IO a swapMVar mvar new =@@ -79,10 +188,11 @@     return old  {-|-  'withMVar' is a safe wrapper for operating on the contents of an-  'MVar'.  This operation is exception-safe: it will replace the+  'withMVar' is an exception-safe wrapper for operating on the contents+  of an 'MVar'.  This operation is exception-safe: it will replace the   original contents of the 'MVar' if an exception is raised (see-  "Control.Exception").+  "Control.Exception").  However, it is only atomic if there are no+  other producers for this 'MVar'. -} {-# INLINE withMVar #-} -- inlining has been reported to have dramatic effects; see@@ -96,9 +206,11 @@     return b  {-|-  A safe wrapper for modifying the contents of an 'MVar'.  Like 'withMVar', -  'modifyMVar' will replace the original contents of the 'MVar' if an-  exception is raised during the operation.+  An exception-safe wrapper for modifying the contents of an 'MVar'.+  Like 'withMVar', 'modifyMVar' will replace the original contents of+  the 'MVar' if an exception is raised during the operation.  This+  function is only atomic if there are no other producers for this+  'MVar'. -} {-# INLINE modifyMVar_ #-} modifyMVar_ :: MVar a -> (a -> IO a) -> IO ()
Control/Concurrent/QSem.hs view
@@ -1,3 +1,9 @@+{-# LANGUAGE Trustworthy #-}+{-# LANGUAGE CPP #-}+#ifdef __GLASGOW_HASKELL__+{-# LANGUAGE DeriveDataTypeable, StandaloneDeriving #-}+#endif+ ----------------------------------------------------------------------------- -- | -- Module      :  Control.Concurrent.QSem@@ -36,7 +42,7 @@  -- |A 'QSem' is a simple quantity semaphore, in which the available -- \"quantity\" is always dealt with in units of one.-newtype QSem = QSem (MVar (Int, [MVar ()]))+newtype QSem = QSem (MVar (Int, [MVar ()])) deriving Eq  INSTANCE_TYPEABLE0(QSem,qSemTc,"QSem")
Control/Concurrent/QSemN.hs view
@@ -1,3 +1,9 @@+{-# LANGUAGE Trustworthy #-}+{-# LANGUAGE CPP #-}+#ifdef __GLASGOW_HASKELL__+{-# LANGUAGE DeriveDataTypeable, StandaloneDeriving #-}+#endif+ ----------------------------------------------------------------------------- -- | -- Module      :  Control.Concurrent.QSemN@@ -31,7 +37,7 @@  -- |A 'QSemN' is a quantity semaphore, in which the available -- \"quantity\" may be signalled or waited for in arbitrary amounts.-newtype QSemN = QSemN (MVar (Int,[(Int,MVar ())]))+newtype QSemN = QSemN (MVar (Int,[(Int,MVar ())])) deriving Eq  INSTANCE_TYPEABLE0(QSemN,qSemNTc,"QSemN")
Control/Concurrent/SampleVar.hs view
@@ -1,3 +1,9 @@+{-# LANGUAGE Trustworthy #-}+{-# LANGUAGE CPP #-}+#ifdef __GLASGOW_HASKELL__+{-# LANGUAGE DeriveDataTypeable, StandaloneDeriving #-}+#endif+ ----------------------------------------------------------------------------- -- | -- Module      :  Control.Concurrent.SampleVar@@ -34,6 +40,10 @@  import Data.Functor ( (<$>) ) +import Data.Typeable++#include "Typeable.h"+ -- | -- Sample variables are slightly different from a normal 'MVar': -- @@ -57,6 +67,8 @@                                        )                                 )     deriving (Eq)++INSTANCE_TYPEABLE1(SampleVar,sampleVarTc,"SampleVar")  -- |Build a new, empty, 'SampleVar' newEmptySampleVar :: IO (SampleVar a)
Control/Exception.hs view
@@ -1,4 +1,5 @@-{-# OPTIONS_GHC -XNoImplicitPrelude #-}+{-# LANGUAGE Trustworthy #-}+{-# LANGUAGE CPP, NoImplicitPrelude, ExistentialQuantification #-}  ----------------------------------------------------------------------------- -- |@@ -114,6 +115,7 @@         uninterruptibleMask_,         MaskingState(..),         getMaskingState,+        allowInterrupt, #endif          -- ** (deprecated) Asynchronous exception control@@ -122,7 +124,7 @@         unblock,         blocked, -        -- *** Applying @block@ to an exception handler+        -- *** Applying @mask@ to an exception handler          -- $block_handler @@ -149,6 +151,7 @@  #ifdef __GLASGOW_HASKELL__ import GHC.Base+import GHC.IO (unsafeUnmask) import Data.Maybe #else import Prelude hiding (catch)@@ -231,6 +234,16 @@ -- ----------------------------------------------------------------------------- -- Asynchronous exceptions +-- | When invoked inside 'mask', this function allows a blocked+-- asynchronous exception to be raised, if one exists.  It is+-- equivalent to performing an interruptible operation (see+-- #interruptible#), but does not involve any actual blocking.+--+-- When called outside 'mask', or inside 'uninterruptibleMask', this+-- function has no effect.+allowInterrupt :: IO ()+allowInterrupt = unsafeUnmask $ return ()+ {- $async   #AsynchronousExceptions# Asynchronous exceptions are so-called because they arise due to@@ -258,12 +271,12 @@ what you want most of the time - it eliminates a common race condition in starting an exception handler, because there may be no exception handler on the stack to handle another exception if one arrives-immediately.  If asynchronous exceptions are blocked on entering the+immediately.  If asynchronous exceptions are masked on entering the handler, though, we have time to install a new exception handler before being interrupted.  If this weren\'t the default, one would have to write something like ->      block $ \restore ->+>      mask $ \restore -> >           catch (restore (...)) >                 (\e -> handler) @@ -279,7 +292,7 @@   #interruptible# Some operations are /interruptible/, which means that they can receive-asynchronous exceptions even in the scope of a 'block'.  Any function+asynchronous exceptions even in the scope of a 'mask'.  Any function which may itself block is defined as interruptible; this includes 'Control.Concurrent.MVar.takeMVar' (but not 'Control.Concurrent.MVar.tryTakeMVar'),@@ -303,14 +316,15 @@ 'System.IO.openFile'.  It is useful to think of 'mask' not as a way to completely prevent-asynchronous exceptions, but as a filter that allows them to be raised-only at certain places.  The main difficulty with asynchronous+asynchronous exceptions, but as a way to switch from asynchronous mode+to polling mode.  The main difficulty with asynchronous exceptions is that they normally can occur anywhere, but within a 'mask' an asynchronous exception is only raised by operations that are interruptible (or call other interruptible operations).  In many cases these operations may themselves raise exceptions, such as I\/O errors,-so the caller should be prepared to handle exceptions arising from the-operation anyway.+so the caller will usually be prepared to handle exceptions arising from the+operation anyway.  To perfom an explicit poll for asynchronous exceptions+inside 'mask', use 'allowInterrupt'.  Sometimes it is too onerous to handle exceptions in the middle of a critical piece of stateful code.  There are three ways to handle this
Control/Exception/Base.hs view
@@ -1,4 +1,8 @@-{-# OPTIONS_GHC -XNoImplicitPrelude #-}+{-# LANGUAGE Trustworthy #-}+{-# LANGUAGE CPP, NoImplicitPrelude, MagicHash #-}+#ifdef __GLASGOW_HASKELL__+{-# LANGUAGE DeriveDataTypeable, StandaloneDeriving #-}+#endif  #include "Typeable.h" @@ -116,7 +120,7 @@  #ifdef __GLASGOW_HASKELL__ import GHC.Base-import GHC.IO hiding (finally,onException)+import GHC.IO hiding (bracket,finally,onException) import GHC.IO.Exception import GHC.Exception import GHC.Show@@ -397,7 +401,7 @@         -> (e -> IO a)  -- ^ Handler to invoke if an exception is raised         -> IO a #if __GLASGOW_HASKELL__-catch = GHC.IO.catchException+catch = catchException #elif __HUGS__ catch m h = Hugs.Exception.catchException m h'   where h' e = case fromException e of@@ -426,7 +430,7 @@         -> IO a catchJust p a handler = catch a handler'   where handler' e = case p e of-                        Nothing -> throw e+                        Nothing -> throwIO e                         Just b  -> handler b  -- | A version of 'catch' with the arguments swapped around; useful in@@ -452,7 +456,7 @@  mapException :: (Exception e1, Exception e2) => (e1 -> e2) -> a -> a mapException f v = unsafePerformIO (catch (evaluate v)-                                          (\x -> throw (f x)))+                                          (\x -> throwIO (f x)))  ----------------------------------------------------------------------------- -- 'try' and variations.@@ -482,14 +486,14 @@   case r of         Right v -> return (Right v)         Left  e -> case p e of-                        Nothing -> throw e+                        Nothing -> throwIO e                         Just b  -> return (Left b)  -- | 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-                                          throw (e :: SomeException)+                                          throwIO (e :: SomeException)  ----------------------------------------------------------------------------- -- Some Useful Functions
Control/Monad.hs view
@@ -1,4 +1,6 @@-{-# OPTIONS_GHC -XNoImplicitPrelude #-}+{-# LANGUAGE Trustworthy #-}+{-# LANGUAGE CPP, NoImplicitPrelude #-}+ ----------------------------------------------------------------------------- -- | -- Module      :  Control.Monad@@ -188,7 +190,25 @@  -- | @'forever' act@ repeats the action infinitely. forever     :: (Monad m) => m a -> m b+{-# INLINABLE forever #-}  -- See Note [Make forever INLINABLE] forever a   = a >> forever a++{- Note [Make forever INLINABLE]++If you say   x = forever a+you'll get   x = a >> a >> a >> a >> ... etc ...+and that can make a massive space leak (see Trac #5205)++In some monads, where (>>) is expensive, this might be the right+thing, but not in the IO monad.  We want to specialise 'forever' for+the IO monad, so that eta expansion happens and there's no space leak.+To achieve this we must make forever INLINABLE, so that it'll get+specialised at call sites.++Still delicate, though, because it depends on optimisation.  But there+really is a space/time tradeoff here, and only optimisation reveals+the "right" answer.+-}  -- | @'void' value@ discards or ignores the result of evaluation, such as the return value of an 'IO' action. void :: Functor f => f a -> f ()
Control/Monad/Fix.hs view
@@ -1,3 +1,6 @@+{-# LANGUAGE Trustworthy #-}+{-# LANGUAGE CPP #-}+ ----------------------------------------------------------------------------- -- | -- Module      :  Control.Monad.Fix
+ Control/Monad/Group.hs view
@@ -0,0 +1,34 @@+{-# LANGUAGE Trustworthy #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  Control.Monad.Group+-- Copyright   :  (c) Nils Schweinsberg 2011,+--                (c) University Tuebingen 2011+-- License     :  BSD-style (see the file libraries/base/LICENSE)+-- Maintainer  :  libraries@haskell.org+-- Stability   :  experimental+-- Portability :  non-portable+--+-- Monadic grouping (used for monad comprehensions)+--+-----------------------------------------------------------------------------++{-# LANGUAGE CPP, MultiParamTypeClasses, FlexibleInstances #-}++module Control.Monad.Group where++import Prelude+#if defined(__GLASGOW_HASKELL__)+import GHC.Exts (groupWith)+#endif++-- | `MonadGroup` type class without restrictions on the type `t`+class Monad m => MonadGroup m t where+    mgroupWith :: (a -> t) -> m a -> m (m a)++#if defined(__GLASGOW_HASKELL__)+-- | Grouping instance for lists using the `groupWith` function from the+-- "GHC.Exts" library+instance Ord t => MonadGroup [] t where+    mgroupWith = groupWith+#endif
Control/Monad/Instances.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE Safe #-} {-# OPTIONS_NHC98 --prelude #-} -- This module deliberately declares orphan instances: {-# OPTIONS_GHC -fno-warn-orphans #-}
Control/Monad/ST.hs view
@@ -1,9 +1,14 @@+{-# LANGUAGE CPP, SafeImports #-}+#if sh_SAFE_DEFAULT+{-# LANGUAGE Safe #-}+#endif+ ----------------------------------------------------------------------------- -- | -- Module      :  Control.Monad.ST -- Copyright   :  (c) The University of Glasgow 2001 -- License     :  BSD-style (see the file libraries/base/LICENSE)--- +-- -- Maintainer  :  libraries@haskell.org -- Stability   :  experimental -- Portability :  non-portable (requires universal quantification for runST)@@ -14,55 +19,35 @@ -- ----------------------------------------------------------------------------- -module Control.Monad.ST-  (-        -- * The 'ST' Monad-        ST,             -- abstract, instance of Functor, Monad, Typeable.-        runST,          -- :: (forall s. ST s a) -> a-        fixST,          -- :: (a -> ST s a) -> ST s a--        -- * Converting 'ST' to 'IO'-        RealWorld,              -- abstract-        stToIO,                 -- :: ST RealWorld a -> IO a--        -- * Unsafe operations-        unsafeInterleaveST,     -- :: ST s a -> ST s a-        unsafeIOToST,           -- :: IO a -> ST s a-        unsafeSTToIO            -- :: ST s a -> IO a-      ) where--#if defined(__GLASGOW_HASKELL__)-import Control.Monad.Fix ()-#else-import Control.Monad.Fix+module Control.Monad.ST (+          module Control.Monad.ST.Safe+#if !sh_SAFE_DEFAULT+        -- * Unsafe Functions+        , unsafeInterleaveST+        , unsafeIOToST+        , unsafeSTToIO #endif--#include "Typeable.h"+    ) where -#if defined(__GLASGOW_HASKELL__)-import GHC.ST           ( ST, runST, fixST, unsafeInterleaveST )-import GHC.Base         ( RealWorld )-import GHC.IO           ( stToIO, unsafeIOToST, unsafeSTToIO )-#elif defined(__HUGS__)-import Data.Typeable-import Hugs.ST-import qualified Hugs.LazyST as LazyST-#endif+import safe Control.Monad.ST.Safe -#if defined(__HUGS__)-INSTANCE_TYPEABLE2(ST,sTTc,"ST")-INSTANCE_TYPEABLE0(RealWorld,realWorldTc,"RealWorld")+#if !sh_SAFE_DEFAULT+import qualified Control.Monad.ST.Unsafe as U -fixST :: (a -> ST s a) -> ST s a-fixST f = LazyST.lazyToStrictST (LazyST.fixST (LazyST.strictToLazyST . f))+{-# DEPRECATED unsafeInterleaveST, unsafeIOToST, unsafeSTToIO+              "Please import from Control.Monad.ST.Unsafe instead; This will be removed in the next release"+ #-} +{-# INLINE unsafeInterleaveST #-} unsafeInterleaveST :: ST s a -> ST s a-unsafeInterleaveST =-    LazyST.lazyToStrictST . LazyST.unsafeInterleaveST . LazyST.strictToLazyST-#endif+unsafeInterleaveST = U.unsafeInterleaveST -#if !defined(__GLASGOW_HASKELL__)-instance MonadFix (ST s) where-        mfix = fixST+{-# INLINE unsafeIOToST #-}+unsafeIOToST :: IO a -> ST s a+unsafeIOToST = U.unsafeIOToST++{-# INLINE unsafeSTToIO #-}+unsafeSTToIO :: ST s a -> IO a+unsafeSTToIO = U.unsafeSTToIO #endif
+ Control/Monad/ST/Imp.hs view
@@ -0,0 +1,72 @@+{-# LANGUAGE CPP #-}+{-# OPTIONS_HADDOCK hide #-}++-----------------------------------------------------------------------------+-- |+-- Module      :  Control.Monad.ST.Imp+-- Copyright   :  (c) The University of Glasgow 2001+-- License     :  BSD-style (see the file libraries/base/LICENSE)+-- +-- Maintainer  :  libraries@haskell.org+-- Stability   :  experimental+-- Portability :  non-portable (requires universal quantification for runST)+--+-- This library provides support for /strict/ state threads, as+-- described in the PLDI \'94 paper by John Launchbury and Simon Peyton+-- Jones /Lazy Functional State Threads/.+--+-----------------------------------------------------------------------------++-- #hide+module Control.Monad.ST.Imp (+        -- * The 'ST' Monad+        ST,             -- abstract, instance of Functor, Monad, Typeable.+        runST,          -- :: (forall s. ST s a) -> a+        fixST,          -- :: (a -> ST s a) -> ST s a++        -- * Converting 'ST' to 'IO'+        RealWorld,              -- abstract+        stToIO,                 -- :: ST RealWorld a -> IO a++        -- * Unsafe operations+        unsafeInterleaveST,     -- :: ST s a -> ST s a+        unsafeIOToST,           -- :: IO a -> ST s a+        unsafeSTToIO            -- :: ST s a -> IO a+    ) where++#if defined(__GLASGOW_HASKELL__)+import Control.Monad.Fix ()+#else+import Control.Monad.Fix+#endif++#include "Typeable.h"++#if defined(__GLASGOW_HASKELL__)+import GHC.ST           ( ST, runST, fixST, unsafeInterleaveST )+import GHC.Base         ( RealWorld )+import GHC.IO           ( stToIO, unsafeIOToST, unsafeSTToIO )+#elif defined(__HUGS__)+import Data.Typeable+import Hugs.ST+import qualified Hugs.LazyST as LazyST+#endif++#if defined(__HUGS__)+INSTANCE_TYPEABLE2(ST,sTTc,"ST")+INSTANCE_TYPEABLE0(RealWorld,realWorldTc,"RealWorld")++fixST :: (a -> ST s a) -> ST s a+fixST f = LazyST.lazyToStrictST (LazyST.fixST (LazyST.strictToLazyST . f))++unsafeInterleaveST :: ST s a -> ST s a+unsafeInterleaveST =+    LazyST.lazyToStrictST . LazyST.unsafeInterleaveST . LazyST.strictToLazyST+#endif++#if !defined(__GLASGOW_HASKELL__)+instance MonadFix (ST s) where+        mfix = fixST+#endif++
Control/Monad/ST/Lazy.hs view
@@ -1,3 +1,8 @@+{-# LANGUAGE CPP, SafeImports #-}+#if sh_SAFE_DEFAULT+{-# LANGUAGE Safe #-}+#endif+ ----------------------------------------------------------------------------- -- | -- Module      :  Control.Monad.ST.Lazy@@ -15,136 +20,28 @@ -----------------------------------------------------------------------------  module Control.Monad.ST.Lazy (-        -- * The 'ST' monad-        ST,-        runST,-        fixST,--        -- * Converting between strict and lazy 'ST'-        strictToLazyST, lazyToStrictST,--        -- * Converting 'ST' To 'IO'-        RealWorld,-        stToIO,--        -- * Unsafe operations-        unsafeInterleaveST,-        unsafeIOToST-    ) where--import Prelude--import Control.Monad.Fix--import qualified Control.Monad.ST as ST--#ifdef __GLASGOW_HASKELL__-import qualified GHC.ST-import GHC.Base-#endif--#ifdef __HUGS__-import Hugs.LazyST-#endif--#ifdef __GLASGOW_HASKELL__--- | The lazy state-transformer monad.--- A computation of type @'ST' s a@ transforms an internal state indexed--- by @s@, and returns a value of type @a@.--- The @s@ parameter is either------ * an unstantiated type variable (inside invocations of 'runST'), or------ * 'RealWorld' (inside invocations of 'stToIO').------ It serves to keep the internal states of different invocations of--- 'runST' separate from each other and from invocations of 'stToIO'.------ The '>>=' and '>>' operations are not strict in the state.  For example,------ @'runST' (writeSTRef _|_ v >>= readSTRef _|_ >> return 2) = 2@-newtype ST s a = ST (State s -> (a, State s))-data State s = S# (State# s)--instance Functor (ST s) where-    fmap f m = ST $ \ s ->-      let -       ST m_a = m-       (r,new_s) = m_a s-      in-      (f r,new_s)--instance Monad (ST s) where--        return a = ST $ \ s -> (a,s)-        m >> k   =  m >>= \ _ -> k-        fail s   = error s--        (ST m) >>= k-         = ST $ \ s ->-           let-             (r,new_s) = m s-             ST k_a = k r-           in-           k_a new_s--{-# NOINLINE runST #-}--- | Return the value computed by a state transformer computation.--- The @forall@ ensures that the internal state used by the 'ST'--- computation is inaccessible to the rest of the program.-runST :: (forall s. ST s a) -> a-runST st = case st of ST the_st -> let (r,_) = the_st (S# realWorld#) in r---- | Allow the result of a state transformer computation to be used (lazily)--- inside the computation.--- Note that if @f@ is strict, @'fixST' f = _|_@.-fixST :: (a -> ST s a) -> ST s a-fixST m = ST (\ s -> -                let -                   ST m_r = m r-                   (r,s') = m_r s-                in-                   (r,s'))+          module Control.Monad.ST.Lazy.Safe+#if !sh_SAFE_DEFAULT+        -- * Unsafe Functions+        , unsafeInterleaveST+        , unsafeIOToST #endif--instance MonadFix (ST s) where-        mfix = fixST---- ------------------------------------------------------------------------------ Strict <--> Lazy+    ) where -#ifdef __GLASGOW_HASKELL__-{-|-Convert a strict 'ST' computation into a lazy one.  The strict state-thread passed to 'strictToLazyST' is not performed until the result of-the lazy state thread it returns is demanded.--}-strictToLazyST :: ST.ST s a -> ST s a-strictToLazyST m = ST $ \s ->-        let -           pr = case s of { S# s# -> GHC.ST.liftST m s# }-           r  = case pr of { GHC.ST.STret _ v -> v }-           s' = case pr of { GHC.ST.STret s2# _ -> S# s2# }-        in-        (r, s')+import safe Control.Monad.ST.Lazy.Safe+#if !sh_SAFE_DEFAULT+import qualified Control.Monad.ST.Lazy.Unsafe as U -{-| -Convert a lazy 'ST' computation into a strict one.--}-lazyToStrictST :: ST s a -> ST.ST s a-lazyToStrictST (ST m) = GHC.ST.ST $ \s ->-        case (m (S# s)) of (a, S# s') -> (# s', a #)+{-# DEPRECATED unsafeInterleaveST, unsafeIOToST+              "Please import from Control.Monad.ST.Lazy.Unsafe instead; This will be removed in the next release"+ #-} +{-# INLINE unsafeInterleaveST #-} unsafeInterleaveST :: ST s a -> ST s a-unsafeInterleaveST = strictToLazyST . ST.unsafeInterleaveST . lazyToStrictST-#endif+unsafeInterleaveST = U.unsafeInterleaveST +{-# INLINE unsafeIOToST #-} unsafeIOToST :: IO a -> ST s a-unsafeIOToST = strictToLazyST . ST.unsafeIOToST+unsafeIOToST = U.unsafeIOToST+#endif --- | A monad transformer embedding lazy 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.stToIO . lazyToStrictST
+ Control/Monad/ST/Lazy/Imp.hs view
@@ -0,0 +1,162 @@+{-# LANGUAGE CPP, MagicHash, UnboxedTuples, Rank2Types #-}+{-# OPTIONS_HADDOCK hide #-}++-----------------------------------------------------------------------------+-- |+-- Module      :  Control.Monad.ST.Lazy.Imp+-- Copyright   :  (c) The University of Glasgow 2001+-- License     :  BSD-style (see the file libraries/base/LICENSE)+-- +-- Maintainer  :  libraries@haskell.org+-- Stability   :  provisional+-- Portability :  non-portable (requires universal quantification for runST)+--+-- This module presents an identical interface to "Control.Monad.ST",+-- except that the monad delays evaluation of state operations until+-- a value depending on them is required.+--+-----------------------------------------------------------------------------++-- #hide+module Control.Monad.ST.Lazy.Imp (+        -- * The 'ST' monad+        ST,+        runST,+        fixST,++        -- * Converting between strict and lazy 'ST'+        strictToLazyST, lazyToStrictST,++        -- * Converting 'ST' To 'IO'+        RealWorld,+        stToIO,++        -- * Unsafe operations+        unsafeInterleaveST,+        unsafeIOToST+    ) where++import Prelude++import Control.Monad.Fix++import qualified Control.Monad.ST.Safe as ST+import qualified Control.Monad.ST.Unsafe as ST++#ifdef __GLASGOW_HASKELL__+import qualified GHC.ST as GHC.ST+import GHC.Base+#endif++#ifdef __HUGS__+import Hugs.LazyST+#endif++#ifdef __GLASGOW_HASKELL__+-- | The lazy state-transformer monad.+-- A computation of type @'ST' s a@ transforms an internal state indexed+-- by @s@, and returns a value of type @a@.+-- The @s@ parameter is either+--+-- * an unstantiated type variable (inside invocations of 'runST'), or+--+-- * 'RealWorld' (inside invocations of 'stToIO').+--+-- It serves to keep the internal states of different invocations of+-- 'runST' separate from each other and from invocations of 'stToIO'.+--+-- The '>>=' and '>>' operations are not strict in the state.  For example,+--+-- @'runST' (writeSTRef _|_ v >>= readSTRef _|_ >> return 2) = 2@+newtype ST s a = ST (State s -> (a, State s))+data State s = S# (State# s)++instance Functor (ST s) where+    fmap f m = ST $ \ s ->+      let +       ST m_a = m+       (r,new_s) = m_a s+      in+      (f r,new_s)++instance Monad (ST s) where++        return a = ST $ \ s -> (a,s)+        m >> k   =  m >>= \ _ -> k+        fail s   = error s++        (ST m) >>= k+         = ST $ \ s ->+           let+             (r,new_s) = m s+             ST k_a = k r+           in+           k_a new_s++{-# NOINLINE runST #-}+-- | Return the value computed by a state transformer computation.+-- The @forall@ ensures that the internal state used by the 'ST'+-- computation is inaccessible to the rest of the program.+runST :: (forall s. ST s a) -> a+runST st = case st of ST the_st -> let (r,_) = the_st (S# realWorld#) in r++-- | Allow the result of a state transformer computation to be used (lazily)+-- inside the computation.+-- Note that if @f@ is strict, @'fixST' f = _|_@.+fixST :: (a -> ST s a) -> ST s a+fixST m = ST (\ s -> +                let +                   ST m_r = m r+                   (r,s') = m_r s+                in+                   (r,s'))+#endif++instance MonadFix (ST s) where+        mfix = fixST++-- ---------------------------------------------------------------------------+-- Strict <--> Lazy++#ifdef __GLASGOW_HASKELL__+{-|+Convert a strict 'ST' computation into a lazy one.  The strict state+thread passed to 'strictToLazyST' is not performed until the result of+the lazy state thread it returns is demanded.+-}+strictToLazyST :: ST.ST s a -> ST s a+strictToLazyST m = ST $ \s ->+        let +           pr = case s of { S# s# -> GHC.ST.liftST m s# }+           r  = case pr of { GHC.ST.STret _ v -> v }+           s' = case pr of { GHC.ST.STret s2# _ -> S# s2# }+        in+        (r, s')++{-| +Convert a lazy 'ST' computation into a strict one.+-}+lazyToStrictST :: ST s a -> ST.ST s a+lazyToStrictST (ST m) = GHC.ST.ST $ \s ->+        case (m (S# s)) of (a, S# s') -> (# s', a #)+#endif++-- | A monad transformer embedding lazy 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.stToIO . lazyToStrictST++-- ---------------------------------------------------------------------------+-- Strict <--> Lazy++#ifdef __GLASGOW_HASKELL__+unsafeInterleaveST :: ST s a -> ST s a+unsafeInterleaveST = strictToLazyST . ST.unsafeInterleaveST . lazyToStrictST+#endif++unsafeIOToST :: IO a -> ST s a+unsafeIOToST = strictToLazyST . ST.unsafeIOToST++
+ Control/Monad/ST/Lazy/Safe.hs view
@@ -0,0 +1,36 @@+{-# LANGUAGE Trustworthy #-}++-----------------------------------------------------------------------------+-- |+-- Module      :  Control.Monad.ST.Lazy.Safe+-- Copyright   :  (c) The University of Glasgow 2001+-- License     :  BSD-style (see the file libraries/base/LICENSE)+--+-- Maintainer  :  libraries@haskell.org+-- Stability   :  provisional+-- Portability :  non-portable (requires universal quantification for runST)+--+-- This module presents an identical interface to "Control.Monad.ST",+-- except that the monad delays evaluation of state operations until+-- a value depending on them is required.+--+-- Safe API only.+--+-----------------------------------------------------------------------------++module Control.Monad.ST.Lazy.Safe (+        -- * The 'ST' monad+        ST,+        runST,+        fixST,++        -- * Converting between strict and lazy 'ST'+        strictToLazyST, lazyToStrictST,++        -- * Converting 'ST' To 'IO'+        RealWorld,+        stToIO,+    ) where++import Control.Monad.ST.Lazy.Imp+
+ Control/Monad/ST/Lazy/Unsafe.hs view
@@ -0,0 +1,26 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  Control.Monad.ST.Lazy.Unsafe+-- Copyright   :  (c) The University of Glasgow 2001+-- License     :  BSD-style (see the file libraries/base/LICENSE)+--+-- Maintainer  :  libraries@haskell.org+-- Stability   :  provisional+-- Portability :  non-portable (requires universal quantification for runST)+--+-- This module presents an identical interface to "Control.Monad.ST",+-- except that the monad delays evaluation of state operations until+-- a value depending on them is required.+--+-- Unsafe API.+--+-----------------------------------------------------------------------------++module Control.Monad.ST.Lazy.Unsafe (+        -- * Unsafe operations+        unsafeInterleaveST,+        unsafeIOToST+    ) where++import Control.Monad.ST.Lazy.Imp+
+ Control/Monad/ST/Safe.hs view
@@ -0,0 +1,33 @@+{-# LANGUAGE Trustworthy #-}++-----------------------------------------------------------------------------+-- |+-- Module      :  Control.Monad.ST.Safe+-- Copyright   :  (c) The University of Glasgow 2001+-- License     :  BSD-style (see the file libraries/base/LICENSE)+--+-- Maintainer  :  libraries@haskell.org+-- Stability   :  experimental+-- Portability :  non-portable (requires universal quantification for runST)+--+-- This library provides support for /strict/ state threads, as+-- described in the PLDI \'94 paper by John Launchbury and Simon Peyton+-- Jones /Lazy Functional State Threads/.+--+-- Safe API Only.+--+-----------------------------------------------------------------------------++module Control.Monad.ST.Safe (+        -- * The 'ST' Monad+        ST,             -- abstract, instance of Functor, Monad, Typeable.+        runST,          -- :: (forall s. ST s a) -> a+        fixST,          -- :: (a -> ST s a) -> ST s a++        -- * Converting 'ST' to 'IO'+        RealWorld,              -- abstract+        stToIO,                 -- :: ST RealWorld a -> IO a+    ) where++import Control.Monad.ST.Imp+
Control/Monad/ST/Strict.hs view
@@ -1,9 +1,13 @@+{-# LANGUAGE CPP #-}+#if sh_SAFE_DEFAULT+{-# LANGUAGE Safe #-}+#endif ----------------------------------------------------------------------------- -- | -- Module      :  Control.Monad.ST.Strict -- Copyright   :  (c) The University of Glasgow 2001 -- License     :  BSD-style (see the file libraries/base/LICENSE)--- +-- -- Maintainer  :  libraries@haskell.org -- Stability   :  provisional -- Portability :  non-portable (requires universal quantification for runST)@@ -16,4 +20,9 @@         module Control.Monad.ST   ) where +#if sh_SAFE_DEFAULT+import safe Control.Monad.ST+#else import Control.Monad.ST+#endif+
+ Control/Monad/ST/Unsafe.hs view
@@ -0,0 +1,27 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  Control.Monad.ST.Unsafe+-- Copyright   :  (c) The University of Glasgow 2001+-- License     :  BSD-style (see the file libraries/base/LICENSE)+--+-- Maintainer  :  libraries@haskell.org+-- Stability   :  experimental+-- Portability :  non-portable (requires universal quantification for runST)+--+-- This library provides support for /strict/ state threads, as+-- described in the PLDI \'94 paper by John Launchbury and Simon Peyton+-- Jones /Lazy Functional State Threads/.+--+-- Unsafe API.+--+-----------------------------------------------------------------------------++module Control.Monad.ST.Unsafe (+        -- * Unsafe operations+        unsafeInterleaveST,+        unsafeIOToST,+        unsafeSTToIO+    ) where++import Control.Monad.ST.Imp+
+ Control/Monad/Zip.hs view
@@ -0,0 +1,53 @@+{-# LANGUAGE Safe #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  Control.Monad.Zip+-- Copyright   :  (c) Nils Schweinsberg 2011,+--                (c) George Giorgidze 2011+--                (c) University Tuebingen 2011+-- License     :  BSD-style (see the file libraries/base/LICENSE)+-- Maintainer  :  libraries@haskell.org+-- Stability   :  experimental+-- Portability :  portable+--+-- Monadic zipping (used for monad comprehensions)+--+-----------------------------------------------------------------------------++module Control.Monad.Zip where++import Prelude+import Control.Monad (liftM)++-- | `MonadZip` type class. Minimal definition: `mzip` or `mzipWith`+--+-- Instances should satisfy the laws:+--+-- * Naturality :+--+--   > liftM (f *** g) (mzip ma mb) = mzip (liftM f ma) (liftM g mb)+--+-- * Information Preservation:+--+--   > liftM (const ()) ma = liftM (const ()) mb+--   > ==>+--   > munzip (mzip ma mb) = (ma, mb)+--+class Monad m => MonadZip m where++    mzip :: m a -> m b -> m (a,b)+    mzip = mzipWith (,)++    mzipWith :: (a -> b -> c) -> m a -> m b -> m c+    mzipWith f ma mb = liftM (uncurry f) (mzip ma mb)++    munzip :: m (a,b) -> (m a, m b)+    munzip mab = (liftM fst mab, liftM snd mab)+    -- munzip is a member of the class because sometimes+    -- you can implement it more efficiently than the+    -- above default code.  See Trac #4370 comment by giorgidze++instance MonadZip [] where+    mzip     = zip+    mzipWith = zipWith+    munzip   = unzip
Control/OldException.hs view
@@ -1,4 +1,12 @@-{-# OPTIONS_GHC -XNoImplicitPrelude #-}+{-# LANGUAGE Trustworthy #-}+{-# LANGUAGE CPP+           , NoImplicitPrelude+           , ForeignFunctionInterface+           , ExistentialQuantification+  #-}+#ifdef __GLASGOW_HASKELL__+{-# LANGUAGE DeriveDataTypeable, StandaloneDeriving #-}+#endif  #include "Typeable.h"
Data/Bits.hs view
@@ -1,4 +1,6 @@-{-# OPTIONS_GHC -XNoImplicitPrelude #-}+{-# LANGUAGE Trustworthy #-}+{-# LANGUAGE CPP, NoImplicitPrelude, BangPatterns, MagicHash #-}+ ----------------------------------------------------------------------------- -- | -- Module      :  Data.Bits
Data/Bool.hs view
@@ -1,4 +1,6 @@-{-# OPTIONS_GHC -XNoImplicitPrelude #-}+{-# LANGUAGE Trustworthy #-}+{-# LANGUAGE CPP, NoImplicitPrelude #-}+ ----------------------------------------------------------------------------- -- | -- Module      :  Data.Bool
Data/Char.hs view
@@ -1,4 +1,6 @@-{-# OPTIONS_GHC -XNoImplicitPrelude #-}+{-# LANGUAGE Trustworthy #-}+{-# LANGUAGE CPP, NoImplicitPrelude #-}+ ----------------------------------------------------------------------------- -- | -- Module      :  Data.Char@@ -16,8 +18,6 @@ module Data.Char     (       Char--    , String      -- * Character classification     -- | Unicode characters are divided into letters, numbers, marks,
Data/Complex.hs view
@@ -1,3 +1,9 @@+{-# LANGUAGE Trustworthy #-}+{-# LANGUAGE CPP, DeriveDataTypeable #-}+#ifdef __GLASGOW_HASKELL__+{-# LANGUAGE StandaloneDeriving #-}+#endif+ ----------------------------------------------------------------------------- -- | -- Module      :  Data.Complex@@ -62,7 +68,7 @@ -- For a complex number @z@, @'abs' z@ is a number with the magnitude of @z@, -- but oriented in the positive real direction, whereas @'signum' z@ -- has the phase of @z@, but unit magnitude.-data (RealFloat a) => Complex a+data Complex a   = !a :+ !a    -- ^ forms a complex number from its real and imaginary                 -- rectangular components. # if __GLASGOW_HASKELL__
Data/Data.hs view
@@ -1,3 +1,6 @@+{-# LANGUAGE Trustworthy #-}+{-# LANGUAGE CPP, Rank2Types, ScopedTypeVariables #-}+ ----------------------------------------------------------------------------- -- | -- Module      :  Data.Data@@ -585,7 +588,7 @@         (IntRep,    IntConstr i)      -> mkIntConstr dt i         (FloatRep,  FloatConstr f)    -> mkRealConstr dt f         (CharRep,   CharConstr c)     -> mkCharConstr dt c-        _ -> error "repConstr"+        _ -> error "Data.Data.repConstr"   @@ -623,7 +626,7 @@ dataTypeConstrs :: DataType -> [Constr] dataTypeConstrs dt = case datarep dt of                         (AlgRep cons) -> cons-                        _ -> error "dataTypeConstrs"+                        _ -> error "Data.Data.dataTypeConstrs"   -- | Gets the field labels of a constructor.  The list of labels@@ -696,21 +699,21 @@ indexConstr :: DataType -> ConIndex -> Constr indexConstr dt idx = case datarep dt of                         (AlgRep cs) -> cs !! (idx-1)-                        _           -> error "indexConstr"+                        _           -> error "Data.Data.indexConstr"   -- | Gets the index of a constructor (algebraic datatypes only) constrIndex :: Constr -> ConIndex constrIndex con = case constrRep con of                     (AlgConstr idx) -> idx-                    _ -> error "constrIndex"+                    _ -> error "Data.Data.constrIndex"   -- | Gets the maximum constructor index of an algebraic datatype maxConstrIndex :: DataType -> ConIndex maxConstrIndex dt = case dataTypeRep dt of                         AlgRep cs -> length cs-                        _            -> error "maxConstrIndex"+                        _            -> error "Data.Data.maxConstrIndex"   @@ -755,8 +758,8 @@                         { datatype  = dt                         , conrep    = cr                         , constring = str-                        , confields = error "constrFields"-                        , confixity = error "constrFixity"+                        , confields = error "Data.Data.confields"+                        , confixity = error "Data.Data.confixity"                         }  -- | This function is now deprecated. Please use 'mkIntegralConstr' instead.@@ -767,7 +770,7 @@ mkIntegralConstr :: (Integral a) => DataType -> a -> Constr mkIntegralConstr dt i = case datarep dt of                   IntRep -> mkPrimCon dt (show i) (IntConstr (toInteger  i))-                  _ -> error "mkIntegralConstr"+                  _ -> error "Data.Data.mkIntegralConstr"  -- | This function is now deprecated. Please use 'mkRealConstr' instead. {-# DEPRECATED mkFloatConstr "Use mkRealConstr instead" #-}@@ -777,7 +780,7 @@ mkRealConstr :: (Real a) => DataType -> a -> Constr mkRealConstr dt f = case datarep dt of                     FloatRep -> mkPrimCon dt (show f) (FloatConstr (toRational f))-                    _ -> error "mkRealConstr"+                    _ -> error "Data.Data.mkRealConstr"  -- | This function is now deprecated. Please use 'mkCharConstr' instead. {-# DEPRECATED mkStringConstr "Use mkCharConstr instead" #-}@@ -786,14 +789,14 @@   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"+      _ -> error "Data.Data.mkStringConstr: input String must contain a single character"+    _ -> error "Data.Data.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"+                   _ -> error "Data.Data.mkCharConstr"   ------------------------------------------------------------------------------@@ -878,7 +881,7 @@   gunfold _ z c  = case constrIndex c of                      1 -> z False                      2 -> z True-                     _ -> error "gunfold"+                     _ -> error "Data.Data.gunfold(Bool)"   dataTypeOf _ = boolDataType  @@ -891,7 +894,7 @@   toConstr x = mkCharConstr charType x   gunfold _ z c = case constrRep c of                     (CharConstr x) -> z x-                    _ -> error "gunfold"+                    _ -> error "Data.Data.gunfold(Char)"   dataTypeOf _ = charType  @@ -904,7 +907,7 @@   toConstr = mkRealConstr floatType   gunfold _ z c = case constrRep c of                     (FloatConstr x) -> z (realToFrac x)-                    _ -> error "gunfold"+                    _ -> error "Data.Data.gunfold(Float)"   dataTypeOf _ = floatType  @@ -917,7 +920,7 @@   toConstr = mkRealConstr doubleType   gunfold _ z c = case constrRep c of                     (FloatConstr x) -> z (realToFrac x)-                    _ -> error "gunfold"+                    _ -> error "Data.Data.gunfold(Double)"   dataTypeOf _ = doubleType  @@ -930,7 +933,7 @@   toConstr x = mkIntConstr intType (fromIntegral x)   gunfold _ z c = case constrRep c of                     (IntConstr x) -> z (fromIntegral x)-                    _ -> error "gunfold"+                    _ -> error "Data.Data.gunfold(Int)"   dataTypeOf _ = intType  @@ -943,7 +946,7 @@   toConstr = mkIntConstr integerType   gunfold _ z c = case constrRep c of                     (IntConstr x) -> z x-                    _ -> error "gunfold"+                    _ -> error "Data.Data.gunfold(Integer)"   dataTypeOf _ = integerType  @@ -956,7 +959,7 @@   toConstr x = mkIntConstr int8Type (fromIntegral x)   gunfold _ z c = case constrRep c of                     (IntConstr x) -> z (fromIntegral x)-                    _ -> error "gunfold"+                    _ -> error "Data.Data.gunfold(Int8)"   dataTypeOf _ = int8Type  @@ -969,7 +972,7 @@   toConstr x = mkIntConstr int16Type (fromIntegral x)   gunfold _ z c = case constrRep c of                     (IntConstr x) -> z (fromIntegral x)-                    _ -> error "gunfold"+                    _ -> error "Data.Data.gunfold(Int16)"   dataTypeOf _ = int16Type  @@ -982,7 +985,7 @@   toConstr x = mkIntConstr int32Type (fromIntegral x)   gunfold _ z c = case constrRep c of                     (IntConstr x) -> z (fromIntegral x)-                    _ -> error "gunfold"+                    _ -> error "Data.Data.gunfold(Int32)"   dataTypeOf _ = int32Type  @@ -995,7 +998,7 @@   toConstr x = mkIntConstr int64Type (fromIntegral x)   gunfold _ z c = case constrRep c of                     (IntConstr x) -> z (fromIntegral x)-                    _ -> error "gunfold"+                    _ -> error "Data.Data.gunfold(Int64)"   dataTypeOf _ = int64Type  @@ -1008,7 +1011,7 @@   toConstr x = mkIntConstr wordType (fromIntegral x)   gunfold _ z c = case constrRep c of                     (IntConstr x) -> z (fromIntegral x)-                    _ -> error "gunfold"+                    _ -> error "Data.Data.gunfold(Word)"   dataTypeOf _ = wordType  @@ -1021,7 +1024,7 @@   toConstr x = mkIntConstr word8Type (fromIntegral x)   gunfold _ z c = case constrRep c of                     (IntConstr x) -> z (fromIntegral x)-                    _ -> error "gunfold"+                    _ -> error "Data.Data.gunfold(Word8)"   dataTypeOf _ = word8Type  @@ -1034,7 +1037,7 @@   toConstr x = mkIntConstr word16Type (fromIntegral x)   gunfold _ z c = case constrRep c of                     (IntConstr x) -> z (fromIntegral x)-                    _ -> error "gunfold"+                    _ -> error "Data.Data.gunfold(Word16)"   dataTypeOf _ = word16Type  @@ -1047,7 +1050,7 @@   toConstr x = mkIntConstr word32Type (fromIntegral x)   gunfold _ z c = case constrRep c of                     (IntConstr x) -> z (fromIntegral x)-                    _ -> error "gunfold"+                    _ -> error "Data.Data.gunfold(Word32)"   dataTypeOf _ = word32Type  @@ -1060,7 +1063,7 @@   toConstr x = mkIntConstr word64Type (fromIntegral x)   gunfold _ z c = case constrRep c of                     (IntConstr x) -> z (fromIntegral x)-                    _ -> error "gunfold"+                    _ -> error "Data.Data.gunfold(Word64)"   dataTypeOf _ = word64Type  @@ -1076,7 +1079,7 @@   gfoldl k z (a :% b) = z (:%) `k` a `k` b   toConstr _ = ratioConstr   gunfold k z c | constrIndex c == 1 = k (k (z (:%)))-  gunfold _ _ _ = error "gunfold"+  gunfold _ _ _ = error "Data.Data.gunfold(Ratio)"   dataTypeOf _  = ratioDataType  @@ -1098,7 +1101,7 @@   gunfold k z c = case constrIndex c of                     1 -> z []                     2 -> k (k (z (:)))-                    _ -> error "gunfold"+                    _ -> error "Data.Data.gunfold(List)"   dataTypeOf _ = listDataType   dataCast1 f  = gcast1 f @@ -1132,7 +1135,7 @@   gunfold k z c = case constrIndex c of                     1 -> z Nothing                     2 -> k (z Just)-                    _ -> error "gunfold"+                    _ -> error "Data.Data.gunfold(Maybe)"   dataTypeOf _ = maybeDataType   dataCast1 f  = gcast1 f @@ -1160,7 +1163,7 @@                     1 -> z LT                     2 -> z EQ                     3 -> z GT-                    _ -> error "gunfold"+                    _ -> error "Data.Data.gunfold(Ordering)"   dataTypeOf _ = orderingDataType  @@ -1183,7 +1186,7 @@   gunfold k z c = case constrIndex c of                     1 -> k (z Left)                     2 -> k (z Right)-                    _ -> error "gunfold"+                    _ -> error "Data.Data.gunfold(Either)"   dataTypeOf _ = eitherDataType   dataCast2 f  = gcast2 f @@ -1199,7 +1202,7 @@ instance Data () where   toConstr ()   = tuple0Constr   gunfold _ z c | constrIndex c == 1 = z ()-  gunfold _ _ _ = error "gunfold"+  gunfold _ _ _ = error "Data.Data.gunfold(unit)"   dataTypeOf _  = tuple0DataType  @@ -1215,7 +1218,7 @@   gfoldl f z (a,b) = z (,) `f` a `f` b   toConstr (_,_) = tuple2Constr   gunfold k z c | constrIndex c == 1 = k (k (z (,)))-  gunfold _ _ _ = error "gunfold"+  gunfold _ _ _ = error "Data.Data.gunfold(tup2)"   dataTypeOf _  = tuple2DataType   dataCast2 f   = gcast2 f @@ -1232,7 +1235,7 @@   gfoldl f z (a,b,c) = z (,,) `f` a `f` b `f` c   toConstr (_,_,_) = tuple3Constr   gunfold k z c | constrIndex c == 1 = k (k (k (z (,,))))-  gunfold _ _ _ = error "gunfold"+  gunfold _ _ _ = error "Data.Data.gunfold(tup3)"   dataTypeOf _  = tuple3DataType  @@ -1250,7 +1253,7 @@   toConstr (_,_,_,_) = tuple4Constr   gunfold k z c = case constrIndex c of                     1 -> k (k (k (k (z (,,,)))))-                    _ -> error "gunfold"+                    _ -> error "Data.Data.gunfold(tup4)"   dataTypeOf _ = tuple4DataType  @@ -1268,7 +1271,7 @@   toConstr (_,_,_,_,_) = tuple5Constr   gunfold k z c = case constrIndex c of                     1 -> k (k (k (k (k (z (,,,,))))))-                    _ -> error "gunfold"+                    _ -> error "Data.Data.gunfold(tup5)"   dataTypeOf _ = tuple5DataType  @@ -1286,7 +1289,7 @@   toConstr (_,_,_,_,_,_) = tuple6Constr   gunfold k z c = case constrIndex c of                     1 -> k (k (k (k (k (k (z (,,,,,)))))))-                    _ -> error "gunfold"+                    _ -> error "Data.Data.gunfold(tup6)"   dataTypeOf _ = tuple6DataType  @@ -1305,23 +1308,23 @@   toConstr  (_,_,_,_,_,_,_) = tuple7Constr   gunfold k z c = case constrIndex c of                     1 -> k (k (k (k (k (k (k (z (,,,,,,))))))))-                    _ -> error "gunfold"+                    _ -> error "Data.Data.gunfold(tup7)"   dataTypeOf _ = tuple7DataType   ------------------------------------------------------------------------------  instance Typeable a => Data (Ptr a) where-  toConstr _   = error "toConstr"-  gunfold _ _  = error "gunfold"+  toConstr _   = error "Data.Data.toConstr(Ptr)"+  gunfold _ _  = error "Data.Data.gunfold(Ptr)"   dataTypeOf _ = mkNoRepType "GHC.Ptr.Ptr"   ------------------------------------------------------------------------------  instance Typeable a => Data (ForeignPtr a) where-  toConstr _   = error "toConstr"-  gunfold _ _  = error "gunfold"+  toConstr _   = error "Data.Data.toConstr(ForeignPtr)"+  gunfold _ _  = error "Data.Data.gunfold(ForeignPtr)"   dataTypeOf _ = mkNoRepType "GHC.ForeignPtr.ForeignPtr"  @@ -1331,7 +1334,7 @@ instance (Typeable a, Data b, Ix a) => Data (Array a b)  where   gfoldl f z a = z (listArray (bounds a)) `f` (elems a)-  toConstr _   = error "toConstr"-  gunfold _ _  = error "gunfold"+  toConstr _   = error "Data.Data.toConstr(Array)"+  gunfold _ _  = error "Data.Data.gunfold(Array)"   dataTypeOf _ = mkNoRepType "Data.Array.Array"
Data/Dynamic.hs view
@@ -1,4 +1,9 @@-{-# OPTIONS_GHC -XNoImplicitPrelude #-}+{-# LANGUAGE Trustworthy #-}+{-# LANGUAGE CPP, NoImplicitPrelude #-}+#ifdef __GLASGOW_HASKELL__+{-# LANGUAGE DeriveDataTypeable, StandaloneDeriving #-}+#endif+ ----------------------------------------------------------------------------- -- | -- Module      :  Data.Dynamic
Data/Either.hs view
@@ -1,4 +1,9 @@-{-# OPTIONS_GHC -XNoImplicitPrelude #-}+{-# LANGUAGE Trustworthy #-}+{-# LANGUAGE CPP, NoImplicitPrelude #-}+#ifdef __GLASGOW_HASKELL__+{-# LANGUAGE DeriveDataTypeable, DeriveGeneric, StandaloneDeriving #-}+#endif+ ----------------------------------------------------------------------------- -- | -- Module      :  Data.Either@@ -30,6 +35,7 @@ #endif  import Data.Typeable+import GHC.Generics (Generic)  #ifdef __GLASGOW_HASKELL__ {-@@ -47,7 +53,8 @@ used to hold an error value and the 'Right' constructor is used to hold a correct value (mnemonic: \"right\" also means \"correct\"). -}-data  Either a b  =  Left a | Right b   deriving (Eq, Ord, Read, Show)+data  Either a b  =  Left a | Right b+  deriving (Eq, Ord, Read, Show, Generic)  -- | Case analysis for the 'Either' type. -- If the value is @'Left' a@, apply the first function to @a@;
Data/Eq.hs view
@@ -1,4 +1,6 @@-{-# OPTIONS_GHC -XNoImplicitPrelude #-}+{-# LANGUAGE Trustworthy #-}+{-# LANGUAGE CPP, NoImplicitPrelude #-}+ ----------------------------------------------------------------------------- -- | -- Module      :  Data.Eq
Data/Fixed.hs view
@@ -1,5 +1,10 @@+{-# LANGUAGE Trustworthy #-}+{-# LANGUAGE CPP #-} {-# OPTIONS -Wall -fno-warn-unused-binds #-} +#ifndef __NHC__+{-# LANGUAGE DeriveDataTypeable #-}+#endif ----------------------------------------------------------------------------- -- | -- Module      :  Data.Fixed@@ -35,6 +40,8 @@ ) where  import Prelude -- necessary to get dependencies right+import Data.Char+import Data.List #ifndef __NHC__ import Data.Typeable import Data.Data@@ -152,9 +159,30 @@     maxnum = 10 ^ digits     fracNum = div (d * maxnum) res +readsFixed :: (HasResolution a) => ReadS (Fixed a)+readsFixed = readsSigned+    where readsSigned ('-' : xs) = [ (negate x, rest)+                                   | (x, rest) <- readsUnsigned xs ]+          readsSigned xs = readsUnsigned xs+          readsUnsigned xs = case span isDigit xs of+                             ([], _) -> []+                             (is, xs') ->+                                 let i = fromInteger (read is)+                                 in case xs' of+                                    '.' : xs'' ->+                                        case span isDigit xs'' of+                                        ([], _) -> []+                                        (js, xs''') ->+                                            let j = fromInteger (read js)+                                                l = genericLength js :: Integer+                                            in [(i + (j / (10 ^ l)), xs''')]+                                    _ -> [(i, xs')]+ instance (HasResolution a) => Show (Fixed a) where     show = showFixed False +instance (HasResolution a) => Read (Fixed a) where+    readsPrec _ = readsFixed  data E0 = E0 #ifndef __NHC__
Data/Foldable.hs view
@@ -1,3 +1,6 @@+{-# LANGUAGE Trustworthy #-}+{-# LANGUAGE CPP #-}+ ----------------------------------------------------------------------------- -- | -- Module      :  Data.Foldable@@ -17,43 +20,43 @@ -- for this module.  module Data.Foldable (-        -- * Folds-        Foldable(..),-        -- ** Special biased folds-        foldr',-        foldl',-        foldrM,-        foldlM,-        -- ** Folding actions-        -- *** Applicative actions-        traverse_,-        for_,-        sequenceA_,-        asum,-        -- *** Monadic actions-        mapM_,-        forM_,-        sequence_,-        msum,-        -- ** Specialized folds-        toList,-        concat,-        concatMap,-        and,-        or,-        any,-        all,-        sum,-        product,-        maximum,-        maximumBy,-        minimum,-        minimumBy,-        -- ** Searches-        elem,-        notElem,-        find-        ) where+    -- * Folds+    Foldable(..),+    -- ** Special biased folds+    foldr',+    foldl',+    foldrM,+    foldlM,+    -- ** Folding actions+    -- *** Applicative actions+    traverse_,+    for_,+    sequenceA_,+    asum,+    -- *** Monadic actions+    mapM_,+    forM_,+    sequence_,+    msum,+    -- ** Specialized folds+    toList,+    concat,+    concatMap,+    and,+    or,+    any,+    all,+    sum,+    product,+    maximum,+    maximumBy,+    minimum,+    minimumBy,+    -- ** Searches+    elem,+    notElem,+    find+    ) where  import Prelude hiding (foldl, foldr, foldl1, foldr1, mapM_, sequence_,                 elem, notElem, concat, concatMap, and, or, any, all,@@ -104,67 +107,69 @@ -- >    foldr f z (Node l k r) = foldr f (f k (foldr f z r)) l -- class Foldable t where-        -- | Combine the elements of a structure using a monoid.-        fold :: Monoid m => t m -> m-        fold = foldMap id+    -- | Combine the elements of a structure using a monoid.+    fold :: Monoid m => t m -> m+    fold = foldMap id -        -- | Map each element of the structure to a monoid,-        -- and combine the results.-        foldMap :: Monoid m => (a -> m) -> t a -> m-        foldMap f = foldr (mappend . f) mempty+    -- | Map each element of the structure to a monoid,+    -- and combine the results.+    foldMap :: Monoid m => (a -> m) -> t a -> m+    foldMap f = foldr (mappend . f) mempty -        -- | Right-associative fold of a structure.-        ---        -- @'foldr' f z = 'Prelude.foldr' f z . 'toList'@-        foldr :: (a -> b -> b) -> b -> t a -> b-        foldr f z t = appEndo (foldMap (Endo . f) t) z+    -- | Right-associative fold of a structure.+    --+    -- @'foldr' f z = 'Prelude.foldr' f z . 'toList'@+    foldr :: (a -> b -> b) -> b -> t a -> b+    foldr f z t = appEndo (foldMap (Endo . f) t) z -        -- | Left-associative fold of a structure.-        ---        -- @'foldl' f z = 'Prelude.foldl' f z . 'toList'@-        foldl :: (a -> b -> a) -> a -> t b -> a-        foldl f z t = appEndo (getDual (foldMap (Dual . Endo . flip f) t)) z+    -- | Left-associative fold of a structure.+    --+    -- @'foldl' f z = 'Prelude.foldl' f z . 'toList'@+    foldl :: (a -> b -> a) -> a -> t b -> a+    foldl f z t = appEndo (getDual (foldMap (Dual . Endo . flip f) t)) z -        -- | A variant of 'foldr' that has no base case,-        -- and thus may only be applied to non-empty structures.-        ---        -- @'foldr1' f = 'Prelude.foldr1' f . 'toList'@-        foldr1 :: (a -> a -> a) -> t a -> a-        foldr1 f xs = fromMaybe (error "foldr1: empty structure")-                        (foldr mf Nothing xs)-          where mf x Nothing = Just x-                mf x (Just y) = Just (f x y)+    -- | A variant of 'foldr' that has no base case,+    -- and thus may only be applied to non-empty structures.+    --+    -- @'foldr1' f = 'Prelude.foldr1' f . 'toList'@+    foldr1 :: (a -> a -> a) -> t a -> a+    foldr1 f xs = fromMaybe (error "foldr1: empty structure")+                    (foldr mf Nothing xs)+      where+        mf x Nothing = Just x+        mf x (Just y) = Just (f x y) -        -- | A variant of 'foldl' that has no base case,-        -- and thus may only be applied to non-empty structures.-        ---        -- @'foldl1' f = 'Prelude.foldl1' f . 'toList'@-        foldl1 :: (a -> a -> a) -> t a -> a-        foldl1 f xs = fromMaybe (error "foldl1: empty structure")-                        (foldl mf Nothing xs)-          where mf Nothing y = Just y-                mf (Just x) y = Just (f x y)+    -- | A variant of 'foldl' that has no base case,+    -- and thus may only be applied to non-empty structures.+    --+    -- @'foldl1' f = 'Prelude.foldl1' f . 'toList'@+    foldl1 :: (a -> a -> a) -> t a -> a+    foldl1 f xs = fromMaybe (error "foldl1: empty structure")+                    (foldl mf Nothing xs)+      where+        mf Nothing y = Just y+        mf (Just x) y = Just (f x y)  -- instances for Prelude types  instance Foldable Maybe where-        foldr _ z Nothing = z-        foldr f z (Just x) = f x z+    foldr _ z Nothing = z+    foldr f z (Just x) = f x z -        foldl _ z Nothing = z-        foldl f z (Just x) = f z x+    foldl _ z Nothing = z+    foldl f z (Just x) = f z x  instance Foldable [] where-        foldr = Prelude.foldr-        foldl = Prelude.foldl-        foldr1 = Prelude.foldr1-        foldl1 = Prelude.foldl1+    foldr = Prelude.foldr+    foldl = Prelude.foldl+    foldr1 = Prelude.foldr1+    foldl1 = Prelude.foldl1  instance Ix i => Foldable (Array i) where-        foldr f z = Prelude.foldr f z . elems-        foldl f z = Prelude.foldl f z . elems-        foldr1 f = Prelude.foldr1 f . elems-        foldl1 f = Prelude.foldl1 f . elems+    foldr f z = Prelude.foldr f z . elems+    foldl f z = Prelude.foldl f z . elems+    foldr1 f = Prelude.foldr1 f . elems+    foldl1 f = Prelude.foldl1 f . elems  -- | Fold over the elements of a structure, -- associating to the right, but strictly.
Data/Function.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE Safe #-} ----------------------------------------------------------------------------- -- | -- Module      :  Data.Function
Data/Functor.hs view
@@ -1,3 +1,6 @@+{-# LANGUAGE Trustworthy #-}+{-# LANGUAGE CPP #-}+ ----------------------------------------------------------------------------- -- | -- Module      :  Data.Functor
Data/HashTable.hs view
@@ -1,4 +1,6 @@-{-# OPTIONS_GHC -XNoImplicitPrelude -funbox-strict-fields -fno-warn-name-shadowing #-}+{-# LANGUAGE Trustworthy #-}+{-# LANGUAGE CPP, NoImplicitPrelude #-}+{-# OPTIONS_GHC -funbox-strict-fields -fno-warn-name-shadowing #-}  ----------------------------------------------------------------------------- -- |
Data/IORef.hs view
@@ -1,4 +1,6 @@-{-# OPTIONS_GHC -XNoImplicitPrelude #-}+{-# LANGUAGE Trustworthy #-}+{-# LANGUAGE CPP, NoImplicitPrelude, MagicHash, UnboxedTuples #-}+ ----------------------------------------------------------------------------- -- | -- Module      :  Data.IORef@@ -26,6 +28,10 @@ #if !defined(__PARALLEL_HASKELL__) && defined(__GLASGOW_HASKELL__)         mkWeakIORef,          -- :: IORef a -> IO () -> IO (Weak (IORef a)) #endif+        -- ** Memory Model++        -- $memmodel+         ) where  #ifdef __HUGS__@@ -35,7 +41,6 @@ #ifdef __GLASGOW_HASKELL__ import GHC.Base import GHC.STRef--- import GHC.IO import GHC.IORef hiding (atomicModifyIORef) import qualified GHC.IORef #if !defined(__PARALLEL_HASKELL__)@@ -54,7 +59,8 @@ #endif  #if defined(__GLASGOW_HASKELL__) && !defined(__PARALLEL_HASKELL__)--- |Make a 'Weak' pointer to an 'IORef'+-- |Make a 'Weak' pointer to an 'IORef', using the second argument as a finalizer+-- to run when 'IORef' is garbage-collected mkWeakIORef :: IORef a -> IO () -> IO (Weak (IORef a)) mkWeakIORef r@(IORef (STRef r#)) f = IO $ \s ->   case mkWeak# r# r f s of (# s1, w #) -> (# s1, Weak w #)@@ -92,3 +98,43 @@     writeIORef r a'     return b #endif++{- $memmodel++  In a concurrent program, 'IORef' operations may appear out-of-order+  to another thread, depending on the memory model of the underlying+  processor architecture.  For example, on x86, loads can move ahead+  of stores, so in the following example:++>  maybePrint :: IORef Bool -> IORef Bool -> IO ()+>  maybePrint myRef yourRef = do+>    writeIORef myRef True+>    yourVal <- readIORef yourRef+>    unless yourVal $ putStrLn "critical section"+>+>  main :: IO ()+>  main = do+>    r1 <- newIORef False+>    r2 <- newIORef False+>    forkIO $ maybePrint r1 r2+>    forkIO $ maybePrint r2 r1+>    threadDelay 1000000++  it is possible that the string @"critical section"@ is printed+  twice, even though there is no interleaving of the operations of the+  two threads that allows that outcome.  The memory model of x86+  allows 'readIORef' to happen before the earlier 'writeIORef'.++  The implementation is required to ensure that reordering of memory+  operations cannot cause type-correct code to go wrong.  In+  particular, when inspecting the value read from an 'IORef', the+  memory writes that created that value must have occurred from the+  point of view of the current therad.++  'atomicModifyIORef' acts as a barrier to reordering.  Multiple+  'atomicModifyIORef' operations occur in strict program order.  An+  'atomicModifyIORef' is never observed to take place ahead of any+  earlier (in program order) 'IORef' operations, or after any later+  'IORef' operations.++-}
Data/Int.hs view
@@ -1,4 +1,6 @@-{-# OPTIONS_GHC -XNoImplicitPrelude #-}+{-# LANGUAGE Trustworthy #-}+{-# LANGUAGE CPP, NoImplicitPrelude #-}+ ----------------------------------------------------------------------------- -- | -- Module      :  Data.Int
Data/Ix.hs view
@@ -1,3 +1,6 @@+{-# LANGUAGE Trustworthy #-}+{-# LANGUAGE CPP #-}+ ----------------------------------------------------------------------------- -- | -- Module      :  Data.Ix
Data/List.hs view
@@ -1,4 +1,6 @@-{-# OPTIONS_GHC -XNoImplicitPrelude #-}+{-# LANGUAGE Trustworthy #-}+{-# LANGUAGE CPP, NoImplicitPrelude, MagicHash #-}+ ----------------------------------------------------------------------------- -- | -- Module      :  Data.List@@ -410,6 +412,8 @@  -- | The 'intersectBy' function is the non-overloaded version of 'intersect'. intersectBy             :: (a -> a -> Bool) -> [a] -> [a] -> [a]+intersectBy _  [] _     =  []+intersectBy _  _  []    =  [] intersectBy eq xs ys    =  [x | x <- xs, any (eq x) ys]  -- | The 'intersperse' function takes an element and a list and@@ -420,9 +424,17 @@  intersperse             :: a -> [a] -> [a] intersperse _   []      = []-intersperse _   [x]     = [x]-intersperse sep (x:xs)  = x : sep : intersperse sep xs+intersperse sep (x:xs)  = x : prependToAll sep xs ++-- Not exported:+-- We want to make every element in the 'intersperse'd list available+-- as soon as possible to avoid space leaks. Experiments suggested that+-- a separate top-level helper is more efficient than a local worker.+prependToAll            :: a -> [a] -> [a]+prependToAll _   []     = []+prependToAll sep (x:xs) = sep : x : prependToAll sep xs+ -- | 'intercalate' @xs xss@ is equivalent to @('concat' ('intersperse' xs xss))@. -- It inserts the list @xs@ in between the lists in @xss@ and concatenates the -- result.@@ -733,19 +745,24 @@ -- -- > inits "abc" == ["","a","ab","abc"] --+-- Note that 'inits' has the following strictness property:+-- @inits _|_ = [] : _|_@ inits                   :: [a] -> [[a]]-inits []                =  [[]]-inits (x:xs)            =  [[]] ++ map (x:) (inits xs)+inits xs                =  [] : case xs of+                                  []      -> []+                                  x : xs' -> map (x :) (inits xs')  -- | The 'tails' function returns all final segments of the argument, -- longest first.  For example, -- -- > tails "abc" == ["abc", "bc", "c",""] --+-- Note that 'tails' has the following strictness property:+-- @tails _|_ = _|_ : _|_@ tails                   :: [a] -> [[a]]-tails []                =  [[]]-tails xxs@(_:xs)        =  xxs : tails xs-+tails xs                =  xs : case xs of+                                  []      -> []+                                  _ : xs' -> tails xs'  -- | The 'subsequences' function returns the list of all subsequences of the argument. --
Data/Maybe.hs view
@@ -1,4 +1,6 @@-{-# OPTIONS_GHC -XNoImplicitPrelude #-}+{-# LANGUAGE Trustworthy #-}+{-# LANGUAGE CPP, NoImplicitPrelude, DeriveGeneric #-}+ ----------------------------------------------------------------------------- -- | -- Module      :  Data.Maybe@@ -32,6 +34,7 @@  #ifdef __GLASGOW_HASKELL__ import GHC.Base+import GHC.Generics (Generic) #endif  #ifdef __NHC__@@ -64,7 +67,7 @@ -- error monad can be built using the 'Data.Either.Either' type.  data  Maybe a  =  Nothing | Just a-  deriving (Eq, Ord)+  deriving (Eq, Ord, Generic)  instance  Functor Maybe  where     fmap _ Nothing       = Nothing
Data/Monoid.hs view
@@ -1,4 +1,6 @@-{-# OPTIONS_GHC -XNoImplicitPrelude #-}+{-# LANGUAGE Trustworthy #-}+{-# LANGUAGE CPP, NoImplicitPrelude #-}+ ----------------------------------------------------------------------------- -- | -- Module      :  Data.Monoid
Data/Ord.hs view
@@ -1,4 +1,6 @@-{-# OPTIONS_GHC -XNoImplicitPrelude #-}+{-# LANGUAGE Trustworthy #-}+{-# LANGUAGE CPP, NoImplicitPrelude #-}+ ----------------------------------------------------------------------------- -- | -- Module      :  Data.Ord
Data/Ratio.hs view
@@ -1,3 +1,6 @@+{-# LANGUAGE Safe #-}+{-# LANGUAGE CPP #-}+ ----------------------------------------------------------------------------- -- | -- Module      :  Data.Ratio
Data/STRef.hs view
@@ -1,3 +1,6 @@+{-# LANGUAGE Trustworthy #-}+{-# LANGUAGE CPP #-}+ ----------------------------------------------------------------------------- -- | -- Module      :  Data.STRef
Data/STRef/Lazy.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE Safe #-} ----------------------------------------------------------------------------- -- | -- Module      :  Data.STRef.Lazy@@ -20,7 +21,7 @@         modifySTRef     -- :: STRef s a -> (a -> a) -> ST s ()  ) where -import Control.Monad.ST.Lazy+import Control.Monad.ST.Lazy.Safe import qualified Data.STRef as ST import Prelude
Data/STRef/Strict.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE Safe #-} ----------------------------------------------------------------------------- -- | -- Module      :  Data.STRef.Strict
Data/String.hs view
@@ -1,4 +1,6 @@-{-# OPTIONS_GHC -XNoImplicitPrelude #-}+{-# LANGUAGE Trustworthy #-}+{-# LANGUAGE CPP, NoImplicitPrelude, FlexibleInstances #-}+ ----------------------------------------------------------------------------- -- | -- Module      :  Data.String@@ -9,23 +11,33 @@ -- Stability   :  experimental -- Portability :  portable ----- Things related to the String type.+-- The @String@ type and associated operations. -- -----------------------------------------------------------------------------  module Data.String (-   IsString(..)+   String+ , IsString(..)++ -- * Functions on strings+ , lines+ , words+ , unlines+ , unwords  ) where  #ifdef __GLASGOW_HASKELL__ import GHC.Base #endif +import Data.List (lines, words, unlines, unwords)+ -- | Class for string-like datastructures; used by the overloaded string --   extension (-foverloaded-strings in GHC). class IsString a where     fromString :: String -> a +#ifndef __NHC__ instance IsString [Char] where     fromString xs = xs-+#endif
Data/Traversable.hs view
@@ -1,3 +1,6 @@+{-# LANGUAGE Trustworthy #-}+{-# LANGUAGE CPP #-}+ ----------------------------------------------------------------------------- -- | -- Module      :  Data.Traversable@@ -28,14 +31,14 @@ -- or qualify uses of these function names with an alias for this module.  module Data.Traversable (-        Traversable(..),-        for,-        forM,-        mapAccumL,-        mapAccumR,-        fmapDefault,-        foldMapDefault,-        ) where+    Traversable(..),+    for,+    forM,+    mapAccumL,+    mapAccumR,+    fmapDefault,+    foldMapDefault,+    ) where  import Prelude hiding (mapM, sequence, foldr) import qualified Prelude (mapM, foldr)@@ -80,41 +83,41 @@ --    ('foldMapDefault'). -- class (Functor t, Foldable t) => Traversable t where-        -- | Map each element of a structure to an action, evaluate-        -- these actions from left to right, and collect the results.-        traverse :: Applicative f => (a -> f b) -> t a -> f (t b)-        traverse f = sequenceA . fmap f+    -- | Map each element of a structure to an action, evaluate+    -- these actions from left to right, and collect the results.+    traverse :: Applicative f => (a -> f b) -> t a -> f (t b)+    traverse f = sequenceA . fmap f -        -- | Evaluate each action in the structure from left to right,-        -- and collect the results.-        sequenceA :: Applicative f => t (f a) -> f (t a)-        sequenceA = traverse id+    -- | Evaluate each action in the structure from left to right,+    -- and collect the results.+    sequenceA :: Applicative f => t (f a) -> f (t a)+    sequenceA = traverse id -        -- | Map each element of a structure to a monadic action, evaluate-        -- these actions from left to right, and collect the results.-        mapM :: Monad m => (a -> m b) -> t a -> m (t b)-        mapM f = unwrapMonad . traverse (WrapMonad . f)+    -- | Map each element of a structure to a monadic action, evaluate+    -- these actions from left to right, and collect the results.+    mapM :: Monad m => (a -> m b) -> t a -> m (t b)+    mapM f = unwrapMonad . traverse (WrapMonad . f) -        -- | Evaluate each monadic action in the structure from left to right,-        -- and collect the results.-        sequence :: Monad m => t (m a) -> m (t a)-        sequence = mapM id+    -- | Evaluate each monadic action in the structure from left to right,+    -- and collect the results.+    sequence :: Monad m => t (m a) -> m (t a)+    sequence = mapM id  -- instances for Prelude types  instance Traversable Maybe where-        traverse _ Nothing = pure Nothing-        traverse f (Just x) = Just <$> f x+    traverse _ Nothing = pure Nothing+    traverse f (Just x) = Just <$> f x  instance Traversable [] where-        {-# INLINE traverse #-} -- so that traverse can fuse-        traverse f = Prelude.foldr cons_f (pure [])-          where cons_f x ys = (:) <$> f x <*> ys+    {-# INLINE traverse #-} -- so that traverse can fuse+    traverse f = Prelude.foldr cons_f (pure [])+      where cons_f x ys = (:) <$> f x <*> ys -        mapM = Prelude.mapM+    mapM = Prelude.mapM  instance Ix i => Traversable (Array i) where-        traverse f arr = listArray (bounds arr) `fmap` traverse f (elems arr)+    traverse f arr = listArray (bounds arr) `fmap` traverse f (elems arr)  -- general functions @@ -132,15 +135,14 @@ newtype StateL s a = StateL { runStateL :: s -> (s, a) }  instance Functor (StateL s) where-        fmap f (StateL k) = StateL $ \ s ->-                let (s', v) = k s in (s', f v)+    fmap f (StateL k) = StateL $ \ s -> let (s', v) = k s in (s', f v)  instance Applicative (StateL s) where-        pure x = StateL (\ s -> (s, x))-        StateL kf <*> StateL kv = StateL $ \ s ->-                let (s', f) = kf s-                    (s'', v) = kv s'-                in (s'', f v)+    pure x = StateL (\ s -> (s, x))+    StateL kf <*> StateL kv = StateL $ \ s ->+        let (s', f) = kf s+            (s'', v) = kv s'+        in (s'', f v)  -- |The 'mapAccumL' function behaves like a combination of 'fmap' -- and 'foldl'; it applies a function to each element of a structure,@@ -153,15 +155,14 @@ newtype StateR s a = StateR { runStateR :: s -> (s, a) }  instance Functor (StateR s) where-        fmap f (StateR k) = StateR $ \ s ->-                let (s', v) = k s in (s', f v)+    fmap f (StateR k) = StateR $ \ s -> let (s', v) = k s in (s', f v)  instance Applicative (StateR s) where-        pure x = StateR (\ s -> (s, x))-        StateR kf <*> StateR kv = StateR $ \ s ->-                let (s', v) = kv s-                    (s'', f) = kf s'-                in (s'', f v)+    pure x = StateR (\ s -> (s, x))+    StateR kf <*> StateR kv = StateR $ \ s ->+        let (s', v) = kv s+            (s'', f) = kf s'+        in (s'', f v)  -- |The 'mapAccumR' function behaves like a combination of 'fmap' -- and 'foldr'; it applies a function to each element of a structure,@@ -170,8 +171,12 @@ mapAccumR :: Traversable t => (a -> b -> (a, c)) -> a -> t b -> (a, t c) mapAccumR f s t = runStateR (traverse (StateR . flip f) t) s --- | This function may be used as a value for `fmap` in a `Functor` instance.+-- | This function may be used as a value for `fmap` in a `Functor`+--   instance, provided that 'traverse' is defined. (Using+--   `fmapDefault` with a `Traversable` instance defined only by+--   'sequenceA' will result in infinite recursion.) fmapDefault :: Traversable t => (a -> b) -> t a -> t b+{-# INLINE fmapDefault #-} fmapDefault f = getId . traverse (Id . f)  -- | This function may be used as a value for `Data.Foldable.foldMap`@@ -184,8 +189,8 @@ newtype Id a = Id { getId :: a }  instance Functor Id where-        fmap f (Id x) = Id (f x)+    fmap f (Id x) = Id (f x)  instance Applicative Id where-        pure = Id-        Id f <*> Id x = Id (f x)+    pure = Id+    Id f <*> Id x = Id (f x)
Data/Tuple.hs view
@@ -1,4 +1,5 @@-{-# OPTIONS_GHC -XNoImplicitPrelude #-}+{-# LANGUAGE Trustworthy #-}+{-# LANGUAGE CPP, NoImplicitPrelude #-} {-# OPTIONS_GHC -fno-warn-unused-imports #-} -- XXX -fno-warn-unused-imports needed for the GHC.Tuple import below. Sigh. -----------------------------------------------------------------------------@@ -44,13 +45,13 @@  import GHC.Base -- We need to depend on GHC.Base so that--- a) so that we get GHC.Bool, GHC.Classes, GHC.Ordering+-- a) so that we get GHC.Classes, GHC.Ordering, GHC.Types  -- b) so that GHC.Base.inline is available, which is used --    when expanding instance declarations  import GHC.Tuple--- We must import GHC.Tuple, to ensure sure that the +-- We must import GHC.Tuple, to ensure sure that the -- data constructors of `(,)' are in scope when we do -- the standalone deriving instance for Eq (a,b) etc
Data/Typeable.hs view
@@ -1,4 +1,12 @@-{-# OPTIONS_GHC -XNoImplicitPrelude -XOverlappingInstances -funbox-strict-fields #-}+{-# LANGUAGE Trustworthy #-}+{-# LANGUAGE CPP+           , NoImplicitPrelude+           , OverlappingInstances+           , ScopedTypeVariables+           , ForeignFunctionInterface+           , FlexibleInstances+  #-}+{-# OPTIONS_GHC -funbox-strict-fields #-}  -- The -XOverlappingInstances flag allows the user to over-ride -- the instances for Typeable given here.  In particular, we provide an instance@@ -39,11 +47,14 @@          -- * Type representations         TypeRep,        -- abstract, instance of: Eq, Show, Typeable-        TyCon,          -- abstract, instance of: Eq, Show, Typeable         showsTypeRep, +        TyCon,          -- abstract, instance of: Eq, Show, Typeable+        tyConString,    -- :: TyCon   -> String+         -- * Construction of type representations         mkTyCon,        -- :: String  -> TyCon+        mkTyCon3,       -- :: String  -> String -> String -> TyCon         mkTyConApp,     -- :: TyCon   -> [TypeRep] -> TypeRep         mkAppTy,        -- :: TypeRep -> TypeRep   -> TypeRep         mkFunTy,        -- :: TypeRep -> TypeRep   -> TypeRep@@ -53,8 +64,8 @@         funResultTy,    -- :: TypeRep -> TypeRep   -> Maybe TypeRep         typeRepTyCon,   -- :: TypeRep -> TyCon         typeRepArgs,    -- :: TypeRep -> [TypeRep]-        tyConString,    -- :: TyCon   -> String-        typeRepKey,     -- :: TypeRep -> IO Int+        typeRepKey,     -- :: TypeRep -> IO TypeRepKey+        TypeRepKey,     -- abstract, instance of Eq, Ord          -- * The other Typeable classes         -- | /Note:/ The general instances are provided for GHC only.@@ -81,35 +92,21 @@    ) where -import qualified Data.HashTable as HT-import Data.Maybe-import Data.Int-import Data.Word-import Data.List( foldl, intersperse )+import Data.Typeable.Internal hiding (mkTyCon)+ import Unsafe.Coerce+import Data.Maybe  #ifdef __GLASGOW_HASKELL__ import GHC.Base-import GHC.Show         (Show(..), ShowS,-                         shows, showString, showChar, showParen) import GHC.Err          (undefined)-import GHC.Num          (Integer, (+))-import GHC.Real         ( rem, Ratio )-import GHC.IORef        (IORef,newIORef)-import GHC.IO           (unsafePerformIO,mask_) --- 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.IOArray-import GHC.MVar-import GHC.ST           ( ST )-import GHC.STRef        ( STRef )-import GHC.Ptr          ( Ptr, FunPtr )-import GHC.Stable       ( StablePtr, newStablePtr, freeStablePtr,-                          deRefStablePtr, castStablePtrToPtr,-                          castPtrToStablePtr )-import GHC.Arr          ( Array, STArray )+import GHC.Fingerprint.Type+import {-# SOURCE #-} GHC.Fingerprint+   -- loop: GHC.Fingerprint -> Foreign.Ptr -> Data.Typeable+   -- Better to break the loop here, because we want non-SOURCE imports+   -- of Data.Typeable as much as possible so we can optimise the derived+   -- instances.  #endif @@ -135,42 +132,14 @@  #include "Typeable.h" -#ifndef __HUGS__---------------------------------------------------------------------              Type representations--------------------------------------------------------------------- | A concrete representation of a (monomorphic) type.  'TypeRep'--- supports reasonably efficient equality.-data TypeRep = TypeRep !Key TyCon [TypeRep] ---- Compare keys for equality-instance Eq TypeRep where-  (TypeRep k1 _ _) == (TypeRep k2 _ _) = k1 == k2---- | An abstract representation of a type constructor.  'TyCon' objects can--- be built using 'mkTyCon'.-data TyCon = TyCon !Key String--instance Eq TyCon where-  (TyCon t1 _) == (TyCon t2 _) = t1 == t2-#endif---- | Returns a unique integer associated with a 'TypeRep'.  This can--- be used for making a mapping with TypeReps--- as the keys, for example.  It is guaranteed that @t1 == t2@ if and only if--- @typeRepKey t1 == typeRepKey t2@.------ It is in the 'IO' monad because the actual value of the key may--- vary from run to run of the program.  You should only rely on--- the equality property, not any actual key value.  The relative ordering--- of keys has no meaning either.+{-# DEPRECATED typeRepKey "TypeRep itself is now an instance of Ord" #-}+-- | (DEPRECATED) Returns a unique key associated with a 'TypeRep'.+-- This function is deprecated because 'TypeRep' itself is now an+-- instance of 'Ord', so mappings can be made directly with 'TypeRep'+-- as the key. ---typeRepKey :: TypeRep -> IO Int-typeRepKey (TypeRep (Key i) _ _) = return i+typeRepKey :: TypeRep -> IO TypeRepKey+typeRepKey (TypeRep f _ _) = return (TypeRepKey f)          --          -- let fTy = mkTyCon "Foo" in show (mkTyConApp (mkTyCon ",,")@@ -183,340 +152,16 @@         -- sequence of commas, e.g., (mkTyCon ",,,,") returns         -- the 5-tuple tycon. ------------------ Construction ------------------------ | Applies a type constructor to a sequence of types-mkTyConApp  :: TyCon -> [TypeRep] -> TypeRep-mkTyConApp tc@(TyCon tc_k _) args -  = TypeRep (appKeys tc_k arg_ks) tc args-  where-    arg_ks = [k | TypeRep k _ _ <- args]---- | A special case of 'mkTyConApp', which applies the function --- type constructor to a pair of types.-mkFunTy  :: TypeRep -> TypeRep -> TypeRep-mkFunTy f a = mkTyConApp funTc [f,a]---- | Splits a type constructor application-splitTyConApp :: TypeRep -> (TyCon,[TypeRep])-splitTyConApp (TypeRep _ tc trs) = (tc,trs)---- | Applies a type to a function type.  Returns: @'Just' u@ if the--- first argument represents a function of type @t -> u@ and the--- second argument represents a function of type @t@.  Otherwise,--- returns 'Nothing'.-funResultTy :: TypeRep -> TypeRep -> Maybe TypeRep-funResultTy trFun trArg-  = case splitTyConApp trFun of-      (tc, [t1,t2]) | tc == funTc && t1 == trArg -> Just t2-      _ -> Nothing---- | Adds a TypeRep argument to a TypeRep.-mkAppTy :: TypeRep -> TypeRep -> TypeRep-mkAppTy (TypeRep tr_k tc trs) arg_tr-  = let (TypeRep arg_k _ _) = arg_tr-     in  TypeRep (appKey tr_k arg_k) tc (trs++[arg_tr])---- If we enforce the restriction that there is only one--- @TyCon@ for a type & it is shared among all its uses,--- we can map them onto Ints very simply. The benefit is,--- of course, that @TyCon@s can then be compared efficiently.---- Provided the implementor of other @Typeable@ instances--- takes care of making all the @TyCon@s CAFs (toplevel constants),--- this will work. ---- If this constraint does turn out to be a sore thumb, changing--- the Eq instance for TyCons is trivial.+newtype TypeRepKey = TypeRepKey Fingerprint+  deriving (Eq,Ord) --- | Builds a 'TyCon' object representing a type constructor.  An--- implementation of "Data.Typeable" should ensure that the following holds:------ >  mkTyCon "a" == mkTyCon "a"---+----------------- Construction --------------------- -mkTyCon :: String       -- ^ the name of the type constructor (should be unique-                        -- in the program, so it might be wise to use the-                        -- fully qualified name).+{-# DEPRECATED mkTyCon "either derive Typeable, or use mkTyCon3 instead" #-}+-- | Backwards-compatible API+mkTyCon :: String       -- ^ unique string         -> TyCon        -- ^ A unique 'TyCon' object-mkTyCon str = TyCon (mkTyConKey str) str------------------- Observation ------------------------- | Observe the type constructor of a type representation-typeRepTyCon :: TypeRep -> TyCon-typeRepTyCon (TypeRep _ tc _) = tc---- | Observe the argument types of a type representation-typeRepArgs :: TypeRep -> [TypeRep]-typeRepArgs (TypeRep _ _ args) = args---- | Observe string encoding of a type representation-tyConString :: TyCon   -> String-tyConString  (TyCon _ str) = str------------------- Showing TypeReps ----------------------instance Show TypeRep where-  showsPrec p (TypeRep _ tycon tys) =-    case tys of-      [] -> showsPrec p tycon-      [x]   | tycon == listTc -> showChar '[' . shows x . showChar ']'-      [a,r] | tycon == funTc  -> showParen (p > 8) $-                                 showsPrec 9 a .-                                 showString " -> " .-                                 showsPrec 8 r-      xs | isTupleTyCon tycon -> showTuple xs-         | otherwise         ->-            showParen (p > 9) $-            showsPrec p tycon . -            showChar ' '      . -            showArgs tys--showsTypeRep :: TypeRep -> ShowS-showsTypeRep = shows--instance Show TyCon where-  showsPrec _ (TyCon _ s) = showString s--isTupleTyCon :: TyCon -> Bool-isTupleTyCon (TyCon _ ('(':',':_)) = True-isTupleTyCon _                     = False---- Some (Show.TypeRep) helpers:--showArgs :: Show a => [a] -> ShowS-showArgs [] = id-showArgs [a] = showsPrec 10 a-showArgs (a:as) = showsPrec 10 a . showString " " . showArgs as --showTuple :: [TypeRep] -> ShowS-showTuple args = showChar '('-               . (foldr (.) id $ intersperse (showChar ',') -                               $ map (showsPrec 10) args)-               . showChar ')'---------------------------------------------------------------------      The Typeable class and friends-------------------------------------------------------------------{- Note [Memoising typeOf]-~~~~~~~~~~~~~~~~~~~~~~~~~~-IMPORTANT: we don't want to recalculate the type-rep once per-call to the dummy argument.  This is what went wrong in Trac #3245-So we help GHC by manually keeping the 'rep' *outside* the value -lambda, thus-    -    typeOfDefault :: forall t a. (Typeable1 t, Typeable a) => t a -> TypeRep-    typeOfDefault = \_ -> rep-      where-        rep = typeOf1 (undefined :: t a) `mkAppTy` -              typeOf  (undefined :: a)--Notice the crucial use of scoped type variables here!--}---- | The class 'Typeable' allows a concrete representation of a type to--- be calculated.-class Typeable a where-  typeOf :: a -> TypeRep-  -- ^ Takes a value of type @a@ and returns a concrete representation-  -- of that type.  The /value/ of the argument should be ignored by-  -- any instance of 'Typeable', so that it is safe to pass 'undefined' as-  -- the argument.---- | Variant for unary type constructors-class Typeable1 t where-  typeOf1 :: t a -> TypeRep--#ifdef __GLASGOW_HASKELL__--- | For defining a 'Typeable' instance from any 'Typeable1' instance.-typeOfDefault :: forall t a. (Typeable1 t, Typeable a) => t a -> TypeRep-typeOfDefault = \_ -> rep- where-   rep = typeOf1 (undefined :: t a) `mkAppTy` -         typeOf  (undefined :: a)-   -- Note [Memoising typeOf]-#else--- | For defining a 'Typeable' instance from any 'Typeable1' instance.-typeOfDefault :: (Typeable1 t, Typeable a) => t a -> TypeRep-typeOfDefault x = typeOf1 x `mkAppTy` typeOf (argType x)- where-   argType :: t a -> a-   argType = undefined-#endif---- | Variant for binary type constructors-class Typeable2 t where-  typeOf2 :: t a b -> TypeRep--#ifdef __GLASGOW_HASKELL__--- | For defining a 'Typeable1' instance from any 'Typeable2' instance.-typeOf1Default :: forall t a b. (Typeable2 t, Typeable a) => t a b -> TypeRep-typeOf1Default = \_ -> rep - where-   rep = typeOf2 (undefined :: t a b) `mkAppTy` -         typeOf  (undefined :: a)-   -- Note [Memoising typeOf]-#else--- | For defining a 'Typeable1' instance from any 'Typeable2' instance.-typeOf1Default :: (Typeable2 t, Typeable a) => t a b -> TypeRep-typeOf1Default x = typeOf2 x `mkAppTy` typeOf (argType x)- where-   argType :: t a b -> a-   argType = undefined-#endif---- | Variant for 3-ary type constructors-class Typeable3 t where-  typeOf3 :: t a b c -> TypeRep--#ifdef __GLASGOW_HASKELL__--- | For defining a 'Typeable2' instance from any 'Typeable3' instance.-typeOf2Default :: forall t a b c. (Typeable3 t, Typeable a) => t a b c -> TypeRep-typeOf2Default = \_ -> rep - where-   rep = typeOf3 (undefined :: t a b c) `mkAppTy` -         typeOf  (undefined :: a)-   -- Note [Memoising typeOf]-#else--- | For defining a 'Typeable2' instance from any 'Typeable3' instance.-typeOf2Default :: (Typeable3 t, Typeable a) => t a b c -> TypeRep-typeOf2Default x = typeOf3 x `mkAppTy` typeOf (argType x)- where-   argType :: t a b c -> a-   argType = undefined-#endif---- | Variant for 4-ary type constructors-class Typeable4 t where-  typeOf4 :: t a b c d -> TypeRep--#ifdef __GLASGOW_HASKELL__--- | For defining a 'Typeable3' instance from any 'Typeable4' instance.-typeOf3Default :: forall t a b c d. (Typeable4 t, Typeable a) => t a b c d -> TypeRep-typeOf3Default = \_ -> rep- where-   rep = typeOf4 (undefined :: t a b c d) `mkAppTy` -         typeOf  (undefined :: a)-   -- Note [Memoising typeOf]-#else--- | For defining a 'Typeable3' instance from any 'Typeable4' instance.-typeOf3Default :: (Typeable4 t, Typeable a) => t a b c d -> TypeRep-typeOf3Default x = typeOf4 x `mkAppTy` typeOf (argType x)- where-   argType :: t a b c d -> a-   argType = undefined-#endif-   --- | Variant for 5-ary type constructors-class Typeable5 t where-  typeOf5 :: t a b c d e -> TypeRep--#ifdef __GLASGOW_HASKELL__--- | For defining a 'Typeable4' instance from any 'Typeable5' instance.-typeOf4Default :: forall t a b c d e. (Typeable5 t, Typeable a) => t a b c d e -> TypeRep-typeOf4Default = \_ -> rep - where-   rep = typeOf5 (undefined :: t a b c d e) `mkAppTy` -         typeOf  (undefined :: a)-   -- Note [Memoising typeOf]-#else--- | For defining a 'Typeable4' instance from any 'Typeable5' instance.-typeOf4Default :: (Typeable5 t, Typeable a) => t a b c d e -> TypeRep-typeOf4Default x = typeOf5 x `mkAppTy` typeOf (argType x)- where-   argType :: t a b c d e -> a-   argType = undefined-#endif---- | Variant for 6-ary type constructors-class Typeable6 t where-  typeOf6 :: t a b c d e f -> TypeRep--#ifdef __GLASGOW_HASKELL__--- | For defining a 'Typeable5' instance from any 'Typeable6' instance.-typeOf5Default :: forall t a b c d e f. (Typeable6 t, Typeable a) => t a b c d e f -> TypeRep-typeOf5Default = \_ -> rep- where-   rep = typeOf6 (undefined :: t a b c d e f) `mkAppTy` -         typeOf  (undefined :: a)-   -- Note [Memoising typeOf]-#else--- | For defining a 'Typeable5' instance from any 'Typeable6' instance.-typeOf5Default :: (Typeable6 t, Typeable a) => t a b c d e f -> TypeRep-typeOf5Default x = typeOf6 x `mkAppTy` typeOf (argType x)- where-   argType :: t a b c d e f -> a-   argType = undefined-#endif---- | Variant for 7-ary type constructors-class Typeable7 t where-  typeOf7 :: t a b c d e f g -> TypeRep--#ifdef __GLASGOW_HASKELL__--- | For defining a 'Typeable6' instance from any 'Typeable7' instance.-typeOf6Default :: forall t a b c d e f g. (Typeable7 t, Typeable a) => t a b c d e f g -> TypeRep-typeOf6Default = \_ -> rep- where-   rep = typeOf7 (undefined :: t a b c d e f g) `mkAppTy` -         typeOf  (undefined :: a)-   -- Note [Memoising typeOf]-#else--- | For defining a 'Typeable6' instance from any 'Typeable7' instance.-typeOf6Default :: (Typeable7 t, Typeable a) => t a b c d e f g -> TypeRep-typeOf6Default x = typeOf7 x `mkAppTy` typeOf (argType x)- where-   argType :: t a b c d e f g -> a-   argType = undefined-#endif--#ifdef __GLASGOW_HASKELL__--- Given a @Typeable@/n/ instance for an /n/-ary type constructor,--- define the instances for partial applications.--- Programmers using non-GHC implementations must do this manually--- for each type constructor.--- (The INSTANCE_TYPEABLE/n/ macros in Typeable.h include this.)---- | One Typeable instance for all Typeable1 instances-instance (Typeable1 s, Typeable a)-       => Typeable (s a) where-  typeOf = typeOfDefault---- | One Typeable1 instance for all Typeable2 instances-instance (Typeable2 s, Typeable a)-       => Typeable1 (s a) where-  typeOf1 = typeOf1Default---- | One Typeable2 instance for all Typeable3 instances-instance (Typeable3 s, Typeable a)-       => Typeable2 (s a) where-  typeOf2 = typeOf2Default---- | One Typeable3 instance for all Typeable4 instances-instance (Typeable4 s, Typeable a)-       => Typeable3 (s a) where-  typeOf3 = typeOf3Default---- | One Typeable4 instance for all Typeable5 instances-instance (Typeable5 s, Typeable a)-       => Typeable4 (s a) where-  typeOf4 = typeOf4Default---- | One Typeable5 instance for all Typeable6 instances-instance (Typeable6 s, Typeable a)-       => Typeable5 (s a) where-  typeOf5 = typeOf5Default---- | One Typeable6 instance for all Typeable7 instances-instance (Typeable7 s, Typeable a)-       => Typeable6 (s a) where-  typeOf6 = typeOf6Default--#endif /* __GLASGOW_HASKELL__ */+mkTyCon name = TyCon (fingerprintString name) "" "" name  ------------------------------------------------------------- --@@ -562,176 +207,3 @@   getArg :: c x -> x    getArg = undefined --------------------------------------------------------------------      Instances of the Typeable classes for Prelude types-------------------------------------------------------------------INSTANCE_TYPEABLE0((),unitTc,"()")-INSTANCE_TYPEABLE1([],listTc,"[]")-INSTANCE_TYPEABLE1(Maybe,maybeTc,"Maybe")-INSTANCE_TYPEABLE1(Ratio,ratioTc,"Ratio")-INSTANCE_TYPEABLE2((->),funTc,"->")-INSTANCE_TYPEABLE1(IO,ioTc,"IO")--#if defined(__GLASGOW_HASKELL__) || defined(__HUGS__)--- Types defined in GHC.MVar-INSTANCE_TYPEABLE1(MVar,mvarTc,"MVar" )-#endif--INSTANCE_TYPEABLE2(Array,arrayTc,"Array")-INSTANCE_TYPEABLE2(IOArray,iOArrayTc,"IOArray")--#ifdef __GLASGOW_HASKELL__--- Hugs has these too, but their Typeable<n> instances are defined--- elsewhere to keep this module within Haskell 98.--- This is important because every invocation of runhugs or ffihugs--- uses this module via Data.Dynamic.-INSTANCE_TYPEABLE2(ST,stTc,"ST")-INSTANCE_TYPEABLE2(STRef,stRefTc,"STRef")-INSTANCE_TYPEABLE3(STArray,sTArrayTc,"STArray")-#endif--#ifndef __NHC__-INSTANCE_TYPEABLE2((,),pairTc,"(,)")-INSTANCE_TYPEABLE3((,,),tup3Tc,"(,,)")-INSTANCE_TYPEABLE4((,,,),tup4Tc,"(,,,)")-INSTANCE_TYPEABLE5((,,,,),tup5Tc,"(,,,,)")-INSTANCE_TYPEABLE6((,,,,,),tup6Tc,"(,,,,,)")-INSTANCE_TYPEABLE7((,,,,,,),tup7Tc,"(,,,,,,)")-#endif /* __NHC__ */--INSTANCE_TYPEABLE1(Ptr,ptrTc,"Ptr")-INSTANCE_TYPEABLE1(FunPtr,funPtrTc,"FunPtr")-#ifndef __GLASGOW_HASKELL__-INSTANCE_TYPEABLE1(ForeignPtr,foreignPtrTc,"ForeignPtr")-#endif-INSTANCE_TYPEABLE1(StablePtr,stablePtrTc,"StablePtr")-INSTANCE_TYPEABLE1(IORef,iORefTc,"IORef")--------------------------------------------------------------- Generate Typeable instances for standard datatypes-------------------------------------------------------------INSTANCE_TYPEABLE0(Bool,boolTc,"Bool")-INSTANCE_TYPEABLE0(Char,charTc,"Char")-INSTANCE_TYPEABLE0(Float,floatTc,"Float")-INSTANCE_TYPEABLE0(Double,doubleTc,"Double")-INSTANCE_TYPEABLE0(Int,intTc,"Int")-#ifndef __NHC__-INSTANCE_TYPEABLE0(Word,wordTc,"Word" )-#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")-INSTANCE_TYPEABLE0(Int32,int32Tc,"Int32")-INSTANCE_TYPEABLE0(Int64,int64Tc,"Int64")--INSTANCE_TYPEABLE0(Word8,word8Tc,"Word8" )-INSTANCE_TYPEABLE0(Word16,word16Tc,"Word16")-INSTANCE_TYPEABLE0(Word32,word32Tc,"Word32")-INSTANCE_TYPEABLE0(Word64,word64Tc,"Word64")--INSTANCE_TYPEABLE0(TyCon,tyconTc,"TyCon")-INSTANCE_TYPEABLE0(TypeRep,typeRepTc,"TypeRep")--#ifdef __GLASGOW_HASKELL__-INSTANCE_TYPEABLE0(RealWorld,realWorldTc,"RealWorld")-#endif-----------------------------------------------------              Internals ---------------------------------------------------#ifndef __HUGS__-newtype Key = Key Int deriving( Eq )-#endif--data KeyPr = KeyPr !Key !Key deriving( Eq )--hashKP :: KeyPr -> Int32-hashKP (KeyPr (Key k1) (Key k2)) = (HT.hashInt k1 + HT.hashInt k2) `rem` HT.prime--data Cache = Cache { next_key :: !(IORef Key),  -- Not used by GHC (calls genSym instead)-                     tc_tbl   :: !(HT.HashTable String Key),-                     ap_tbl   :: !(HT.HashTable KeyPr Key) }--{-# NOINLINE cache #-}-#ifdef __GLASGOW_HASKELL__-foreign import ccall unsafe "RtsTypeable.h getOrSetTypeableStore"-    getOrSetTypeableStore :: Ptr a -> IO (Ptr a)-#endif--cache :: Cache-cache = unsafePerformIO $ do-                empty_tc_tbl <- HT.new (==) HT.hashString-                empty_ap_tbl <- HT.new (==) hashKP-                key_loc      <- newIORef (Key 1) -                let ret = Cache {       next_key = key_loc,-                                        tc_tbl = empty_tc_tbl, -                                        ap_tbl = empty_ap_tbl }-#ifdef __GLASGOW_HASKELL__-                mask_ $ do-                        stable_ref <- newStablePtr ret-                        let ref = castStablePtrToPtr stable_ref-                        ref2 <- getOrSetTypeableStore ref-                        if ref==ref2-                                then deRefStablePtr stable_ref-                                else do-                                        freeStablePtr stable_ref-                                        deRefStablePtr-                                                (castPtrToStablePtr ref2)-#else-                return ret-#endif--newKey :: IORef Key -> IO Key-#ifdef __GLASGOW_HASKELL__-newKey _ = do i <- genSym; return (Key i)-#else-newKey kloc = do { k@(Key i) <- readIORef kloc ;-                   writeIORef kloc (Key (i+1)) ;-                   return k }-#endif--#ifdef __GLASGOW_HASKELL__-foreign import ccall unsafe "genSymZh"-  genSym :: IO Int-#endif--mkTyConKey :: String -> Key-mkTyConKey str -  = unsafePerformIO $ do-        let Cache {next_key = kloc, tc_tbl = tbl} = cache-        mb_k <- HT.lookup tbl str-        case mb_k of-          Just k  -> return k-          Nothing -> do { k <- newKey kloc ;-                          HT.insert tbl str k ;-                          return k }--appKey :: Key -> Key -> Key-appKey k1 k2-  = unsafePerformIO $ do-        let Cache {next_key = kloc, ap_tbl = tbl} = cache-        mb_k <- HT.lookup tbl kpr-        case mb_k of-          Just k  -> return k-          Nothing -> do { k <- newKey kloc ;-                          HT.insert tbl kpr k ;-                          return k }-  where-    kpr = KeyPr k1 k2--appKeys :: Key -> [Key] -> Key-appKeys k ks = foldl appKey k ks
Data/Typeable.hs-boot view
@@ -1,19 +1,9 @@--{-# OPTIONS_GHC -XNoImplicitPrelude #-}+{-# LANGUAGE NoImplicitPrelude #-} -module Data.Typeable where+module Data.Typeable (Typeable, mkTyConApp, cast) where  import Data.Maybe-import GHC.Base--data TypeRep-data TyCon--mkTyCon      :: String -> TyCon-mkTyConApp   :: TyCon -> [TypeRep] -> TypeRep+import {-# SOURCE #-} Data.Typeable.Internal  cast :: (Typeable a, Typeable b) => a -> Maybe b--class Typeable a where-  typeOf :: a -> TypeRep
+ Data/Typeable/Internal.hs view
@@ -0,0 +1,567 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  Data.Typeable.Internal+-- Copyright   :  (c) The University of Glasgow, CWI 2001--2011+-- License     :  BSD-style (see the file libraries/base/LICENSE)+-- +-- The representations of the types TyCon and TypeRep, and the+-- function mkTyCon which is used by derived instances of Typeable to+-- construct a TyCon.+--+-----------------------------------------------------------------------------++{-# LANGUAGE CPP+           , NoImplicitPrelude+           , OverlappingInstances+           , ScopedTypeVariables+           , FlexibleInstances+           , MagicHash #-}+#ifdef __GLASGOW_HASKELL__+{-# LANGUAGE DeriveDataTypeable, StandaloneDeriving #-}+#endif++module Data.Typeable.Internal (+    TypeRep(..),+    TyCon(..),+    mkTyCon,+    mkTyCon3,+    mkTyConApp,+    mkAppTy,+    typeRepTyCon,+    typeOfDefault,+    typeOf1Default,+    typeOf2Default,+    typeOf3Default,+    typeOf4Default,+    typeOf5Default,+    typeOf6Default,+    Typeable(..),+    Typeable1(..),+    Typeable2(..),+    Typeable3(..),+    Typeable4(..),+    Typeable5(..),+    Typeable6(..),+    Typeable7(..),+    mkFunTy,+    splitTyConApp,+    funResultTy,+    typeRepArgs,+    showsTypeRep,+    tyConString,+#if defined(__GLASGOW_HASKELL__)+    listTc, funTc+#endif+  ) where++import GHC.Base+import GHC.Word+import GHC.Show+import GHC.Err          (undefined)+import Data.Maybe+import Data.List+import GHC.Num+import GHC.Real+import GHC.IORef+import GHC.IOArray+import GHC.MVar+import GHC.ST           ( ST )+import GHC.STRef        ( STRef )+import GHC.Ptr          ( Ptr, FunPtr )+import GHC.Stable+import GHC.Arr          ( Array, STArray )+import Data.Int++import GHC.Fingerprint.Type+import {-# SOURCE #-} GHC.Fingerprint+   -- loop: GHC.Fingerprint -> Foreign.Ptr -> Data.Typeable+   -- Better to break the loop here, because we want non-SOURCE imports+   -- of Data.Typeable as much as possible so we can optimise the derived+   -- instances.++-- | A concrete representation of a (monomorphic) type.  'TypeRep'+-- supports reasonably efficient equality.+data TypeRep = TypeRep {-# UNPACK #-} !Fingerprint TyCon [TypeRep]++-- Compare keys for equality+instance Eq TypeRep where+  (TypeRep k1 _ _) == (TypeRep k2 _ _) = k1 == k2++instance Ord TypeRep where+  (TypeRep k1 _ _) <= (TypeRep k2 _ _) = k1 <= k2++-- | An abstract representation of a type constructor.  'TyCon' objects can+-- be built using 'mkTyCon'.+data TyCon = TyCon {+   tyConHash    :: {-# UNPACK #-} !Fingerprint,+   tyConPackage :: String,+   tyConModule  :: String,+   tyConName    :: String+ }++instance Eq TyCon where+  (TyCon t1 _ _ _) == (TyCon t2 _ _ _) = t1 == t2++instance Ord TyCon where+  (TyCon k1 _ _ _) <= (TyCon k2 _ _ _) = k1 <= k2++----------------- Construction --------------------++#include "MachDeps.h"++-- mkTyCon is an internal function to make it easier for GHC to+-- generate derived instances.  GHC precomputes the MD5 hash for the+-- TyCon and passes it as two separate 64-bit values to mkTyCon.  The+-- TyCon for a derived Typeable instance will end up being statically+-- allocated.++#if WORD_SIZE_IN_BITS < 64+mkTyCon :: Word64# -> Word64# -> String -> String -> String -> TyCon+#else+mkTyCon :: Word#   -> Word#   -> String -> String -> String -> TyCon+#endif+mkTyCon high# low# pkg modl name+  = TyCon (Fingerprint (W64# high#) (W64# low#)) pkg modl name++-- | Applies a type constructor to a sequence of types+mkTyConApp  :: TyCon -> [TypeRep] -> TypeRep+mkTyConApp tc@(TyCon tc_k _ _ _) []+  = TypeRep tc_k tc [] -- optimisation: all derived Typeable instances+                       -- end up here, and it helps generate smaller+                       -- code for derived Typeable.+mkTyConApp tc@(TyCon tc_k _ _ _) args+  = TypeRep (fingerprintFingerprints (tc_k : arg_ks)) tc args+  where+    arg_ks = [k | TypeRep k _ _ <- args]++-- | A special case of 'mkTyConApp', which applies the function +-- type constructor to a pair of types.+mkFunTy  :: TypeRep -> TypeRep -> TypeRep+mkFunTy f a = mkTyConApp funTc [f,a]++-- | Splits a type constructor application+splitTyConApp :: TypeRep -> (TyCon,[TypeRep])+splitTyConApp (TypeRep _ tc trs) = (tc,trs)++-- | Applies a type to a function type.  Returns: @'Just' u@ if the+-- first argument represents a function of type @t -> u@ and the+-- second argument represents a function of type @t@.  Otherwise,+-- returns 'Nothing'.+funResultTy :: TypeRep -> TypeRep -> Maybe TypeRep+funResultTy trFun trArg+  = case splitTyConApp trFun of+      (tc, [t1,t2]) | tc == funTc && t1 == trArg -> Just t2+      _ -> Nothing++-- | Adds a TypeRep argument to a TypeRep.+mkAppTy :: TypeRep -> TypeRep -> TypeRep+mkAppTy (TypeRep tr_k tc trs) arg_tr+  = let (TypeRep arg_k _ _) = arg_tr+     in  TypeRep (fingerprintFingerprints [tr_k,arg_k]) tc (trs++[arg_tr])++-- | Builds a 'TyCon' object representing a type constructor.  An+-- implementation of "Data.Typeable" should ensure that the following holds:+--+-- >  A==A' ^ B==B' ^ C==C' ==> mkTyCon A B C == mkTyCon A' B' C'+--++--+mkTyCon3 :: String       -- ^ package name+         -> String       -- ^ module name+         -> String       -- ^ the name of the type constructor+         -> TyCon        -- ^ A unique 'TyCon' object+mkTyCon3 pkg modl name =+  TyCon (fingerprintString (unwords [pkg, modl, name])) pkg modl name++----------------- Observation ---------------------++-- | Observe the type constructor of a type representation+typeRepTyCon :: TypeRep -> TyCon+typeRepTyCon (TypeRep _ tc _) = tc++-- | Observe the argument types of a type representation+typeRepArgs :: TypeRep -> [TypeRep]+typeRepArgs (TypeRep _ _ args) = args++-- | Observe string encoding of a type representation+tyConString :: TyCon   -> String+tyConString = tyConName++-------------------------------------------------------------+--+--      The Typeable class and friends+--+-------------------------------------------------------------++{- Note [Memoising typeOf]+~~~~~~~~~~~~~~~~~~~~~~~~~~+IMPORTANT: we don't want to recalculate the type-rep once per+call to the dummy argument.  This is what went wrong in Trac #3245+So we help GHC by manually keeping the 'rep' *outside* the value +lambda, thus+    +    typeOfDefault :: forall t a. (Typeable1 t, Typeable a) => t a -> TypeRep+    typeOfDefault = \_ -> rep+      where+        rep = typeOf1 (undefined :: t a) `mkAppTy` +              typeOf  (undefined :: a)++Notice the crucial use of scoped type variables here!+-}++-- | The class 'Typeable' allows a concrete representation of a type to+-- be calculated.+class Typeable a where+  typeOf :: a -> TypeRep+  -- ^ Takes a value of type @a@ and returns a concrete representation+  -- of that type.  The /value/ of the argument should be ignored by+  -- any instance of 'Typeable', so that it is safe to pass 'undefined' as+  -- the argument.++-- | Variant for unary type constructors+class Typeable1 t where+  typeOf1 :: t a -> TypeRep++#ifdef __GLASGOW_HASKELL__+-- | For defining a 'Typeable' instance from any 'Typeable1' instance.+typeOfDefault :: forall t a. (Typeable1 t, Typeable a) => t a -> TypeRep+typeOfDefault = \_ -> rep+ where+   rep = typeOf1 (undefined :: t a) `mkAppTy` +         typeOf  (undefined :: a)+   -- Note [Memoising typeOf]+#else+-- | For defining a 'Typeable' instance from any 'Typeable1' instance.+typeOfDefault :: (Typeable1 t, Typeable a) => t a -> TypeRep+typeOfDefault x = typeOf1 x `mkAppTy` typeOf (argType x)+ where+   argType :: t a -> a+   argType = undefined+#endif++-- | Variant for binary type constructors+class Typeable2 t where+  typeOf2 :: t a b -> TypeRep++#ifdef __GLASGOW_HASKELL__+-- | For defining a 'Typeable1' instance from any 'Typeable2' instance.+typeOf1Default :: forall t a b. (Typeable2 t, Typeable a) => t a b -> TypeRep+typeOf1Default = \_ -> rep + where+   rep = typeOf2 (undefined :: t a b) `mkAppTy` +         typeOf  (undefined :: a)+   -- Note [Memoising typeOf]+#else+-- | For defining a 'Typeable1' instance from any 'Typeable2' instance.+typeOf1Default :: (Typeable2 t, Typeable a) => t a b -> TypeRep+typeOf1Default x = typeOf2 x `mkAppTy` typeOf (argType x)+ where+   argType :: t a b -> a+   argType = undefined+#endif++-- | Variant for 3-ary type constructors+class Typeable3 t where+  typeOf3 :: t a b c -> TypeRep++#ifdef __GLASGOW_HASKELL__+-- | For defining a 'Typeable2' instance from any 'Typeable3' instance.+typeOf2Default :: forall t a b c. (Typeable3 t, Typeable a) => t a b c -> TypeRep+typeOf2Default = \_ -> rep + where+   rep = typeOf3 (undefined :: t a b c) `mkAppTy` +         typeOf  (undefined :: a)+   -- Note [Memoising typeOf]+#else+-- | For defining a 'Typeable2' instance from any 'Typeable3' instance.+typeOf2Default :: (Typeable3 t, Typeable a) => t a b c -> TypeRep+typeOf2Default x = typeOf3 x `mkAppTy` typeOf (argType x)+ where+   argType :: t a b c -> a+   argType = undefined+#endif++-- | Variant for 4-ary type constructors+class Typeable4 t where+  typeOf4 :: t a b c d -> TypeRep++#ifdef __GLASGOW_HASKELL__+-- | For defining a 'Typeable3' instance from any 'Typeable4' instance.+typeOf3Default :: forall t a b c d. (Typeable4 t, Typeable a) => t a b c d -> TypeRep+typeOf3Default = \_ -> rep+ where+   rep = typeOf4 (undefined :: t a b c d) `mkAppTy` +         typeOf  (undefined :: a)+   -- Note [Memoising typeOf]+#else+-- | For defining a 'Typeable3' instance from any 'Typeable4' instance.+typeOf3Default :: (Typeable4 t, Typeable a) => t a b c d -> TypeRep+typeOf3Default x = typeOf4 x `mkAppTy` typeOf (argType x)+ where+   argType :: t a b c d -> a+   argType = undefined+#endif+   +-- | Variant for 5-ary type constructors+class Typeable5 t where+  typeOf5 :: t a b c d e -> TypeRep++#ifdef __GLASGOW_HASKELL__+-- | For defining a 'Typeable4' instance from any 'Typeable5' instance.+typeOf4Default :: forall t a b c d e. (Typeable5 t, Typeable a) => t a b c d e -> TypeRep+typeOf4Default = \_ -> rep + where+   rep = typeOf5 (undefined :: t a b c d e) `mkAppTy` +         typeOf  (undefined :: a)+   -- Note [Memoising typeOf]+#else+-- | For defining a 'Typeable4' instance from any 'Typeable5' instance.+typeOf4Default :: (Typeable5 t, Typeable a) => t a b c d e -> TypeRep+typeOf4Default x = typeOf5 x `mkAppTy` typeOf (argType x)+ where+   argType :: t a b c d e -> a+   argType = undefined+#endif++-- | Variant for 6-ary type constructors+class Typeable6 t where+  typeOf6 :: t a b c d e f -> TypeRep++#ifdef __GLASGOW_HASKELL__+-- | For defining a 'Typeable5' instance from any 'Typeable6' instance.+typeOf5Default :: forall t a b c d e f. (Typeable6 t, Typeable a) => t a b c d e f -> TypeRep+typeOf5Default = \_ -> rep+ where+   rep = typeOf6 (undefined :: t a b c d e f) `mkAppTy` +         typeOf  (undefined :: a)+   -- Note [Memoising typeOf]+#else+-- | For defining a 'Typeable5' instance from any 'Typeable6' instance.+typeOf5Default :: (Typeable6 t, Typeable a) => t a b c d e f -> TypeRep+typeOf5Default x = typeOf6 x `mkAppTy` typeOf (argType x)+ where+   argType :: t a b c d e f -> a+   argType = undefined+#endif++-- | Variant for 7-ary type constructors+class Typeable7 t where+  typeOf7 :: t a b c d e f g -> TypeRep++#ifdef __GLASGOW_HASKELL__+-- | For defining a 'Typeable6' instance from any 'Typeable7' instance.+typeOf6Default :: forall t a b c d e f g. (Typeable7 t, Typeable a) => t a b c d e f g -> TypeRep+typeOf6Default = \_ -> rep+ where+   rep = typeOf7 (undefined :: t a b c d e f g) `mkAppTy` +         typeOf  (undefined :: a)+   -- Note [Memoising typeOf]+#else+-- | For defining a 'Typeable6' instance from any 'Typeable7' instance.+typeOf6Default :: (Typeable7 t, Typeable a) => t a b c d e f g -> TypeRep+typeOf6Default x = typeOf7 x `mkAppTy` typeOf (argType x)+ where+   argType :: t a b c d e f g -> a+   argType = undefined+#endif++#ifdef __GLASGOW_HASKELL__+-- Given a @Typeable@/n/ instance for an /n/-ary type constructor,+-- define the instances for partial applications.+-- Programmers using non-GHC implementations must do this manually+-- for each type constructor.+-- (The INSTANCE_TYPEABLE/n/ macros in Typeable.h include this.)++-- | One Typeable instance for all Typeable1 instances+instance (Typeable1 s, Typeable a)+       => Typeable (s a) where+  typeOf = typeOfDefault++-- | One Typeable1 instance for all Typeable2 instances+instance (Typeable2 s, Typeable a)+       => Typeable1 (s a) where+  typeOf1 = typeOf1Default++-- | One Typeable2 instance for all Typeable3 instances+instance (Typeable3 s, Typeable a)+       => Typeable2 (s a) where+  typeOf2 = typeOf2Default++-- | One Typeable3 instance for all Typeable4 instances+instance (Typeable4 s, Typeable a)+       => Typeable3 (s a) where+  typeOf3 = typeOf3Default++-- | One Typeable4 instance for all Typeable5 instances+instance (Typeable5 s, Typeable a)+       => Typeable4 (s a) where+  typeOf4 = typeOf4Default++-- | One Typeable5 instance for all Typeable6 instances+instance (Typeable6 s, Typeable a)+       => Typeable5 (s a) where+  typeOf5 = typeOf5Default++-- | One Typeable6 instance for all Typeable7 instances+instance (Typeable7 s, Typeable a)+       => Typeable6 (s a) where+  typeOf6 = typeOf6Default++#endif /* __GLASGOW_HASKELL__ */++----------------- Showing TypeReps --------------------++instance Show TypeRep where+  showsPrec p (TypeRep _ tycon tys) =+    case tys of+      [] -> showsPrec p tycon+      [x]   | tycon == listTc -> showChar '[' . shows x . showChar ']'+      [a,r] | tycon == funTc  -> showParen (p > 8) $+                                 showsPrec 9 a .+                                 showString " -> " .+                                 showsPrec 8 r+      xs | isTupleTyCon tycon -> showTuple xs+         | otherwise         ->+            showParen (p > 9) $+            showsPrec p tycon . +            showChar ' '      . +            showArgs tys++showsTypeRep :: TypeRep -> ShowS+showsTypeRep = shows++instance Show TyCon where+  showsPrec _ t = showString (tyConName t)++isTupleTyCon :: TyCon -> Bool+isTupleTyCon (TyCon _ _ _ ('(':',':_)) = True+isTupleTyCon _                         = False++-- Some (Show.TypeRep) helpers:++showArgs :: Show a => [a] -> ShowS+showArgs [] = id+showArgs [a] = showsPrec 10 a+showArgs (a:as) = showsPrec 10 a . showString " " . showArgs as ++showTuple :: [TypeRep] -> ShowS+showTuple args = showChar '('+               . (foldr (.) id $ intersperse (showChar ',') +                               $ map (showsPrec 10) args)+               . showChar ')'++#if defined(__GLASGOW_HASKELL__)+listTc :: TyCon+listTc = typeRepTyCon (typeOf [()])++funTc :: TyCon+funTc = mkTyCon3 "ghc-prim" "GHC.Types" "->"+#endif++-------------------------------------------------------------+--+--      Instances of the Typeable classes for Prelude types+--+-------------------------------------------------------------++#include "Typeable.h"++INSTANCE_TYPEABLE0((),unitTc,"()")+INSTANCE_TYPEABLE1([],listTc,"[]")+INSTANCE_TYPEABLE1(Maybe,maybeTc,"Maybe")+INSTANCE_TYPEABLE1(Ratio,ratioTc,"Ratio")+#if defined(__GLASGOW_HASKELL__)+{-+TODO: Deriving this instance fails with:+libraries/base/Data/Typeable.hs:589:1:+    Can't make a derived instance of `Typeable2 (->)':+      The last argument of the instance must be a data or newtype application+    In the stand-alone deriving instance for `Typeable2 (->)'+-}+instance Typeable2 (->) where { typeOf2 _ = mkTyConApp funTc [] }+#else+INSTANCE_TYPEABLE2((->),funTc,"->")+#endif+INSTANCE_TYPEABLE1(IO,ioTc,"IO")++#if defined(__GLASGOW_HASKELL__) || defined(__HUGS__)+-- Types defined in GHC.MVar+INSTANCE_TYPEABLE1(MVar,mvarTc,"MVar" )+#endif++INSTANCE_TYPEABLE2(Array,arrayTc,"Array")+INSTANCE_TYPEABLE2(IOArray,iOArrayTc,"IOArray")++#ifdef __GLASGOW_HASKELL__+-- Hugs has these too, but their Typeable<n> instances are defined+-- elsewhere to keep this module within Haskell 98.+-- This is important because every invocation of runhugs or ffihugs+-- uses this module via Data.Dynamic.+INSTANCE_TYPEABLE2(ST,stTc,"ST")+INSTANCE_TYPEABLE2(STRef,stRefTc,"STRef")+INSTANCE_TYPEABLE3(STArray,sTArrayTc,"STArray")+#endif++#ifndef __NHC__+INSTANCE_TYPEABLE2((,),pairTc,"(,)")+INSTANCE_TYPEABLE3((,,),tup3Tc,"(,,)")+INSTANCE_TYPEABLE4((,,,),tup4Tc,"(,,,)")+INSTANCE_TYPEABLE5((,,,,),tup5Tc,"(,,,,)")+INSTANCE_TYPEABLE6((,,,,,),tup6Tc,"(,,,,,)")+INSTANCE_TYPEABLE7((,,,,,,),tup7Tc,"(,,,,,,)")+#endif /* __NHC__ */++INSTANCE_TYPEABLE1(Ptr,ptrTc,"Ptr")+INSTANCE_TYPEABLE1(FunPtr,funPtrTc,"FunPtr")+#ifndef __GLASGOW_HASKELL__+INSTANCE_TYPEABLE1(ForeignPtr,foreignPtrTc,"ForeignPtr")+#endif+INSTANCE_TYPEABLE1(StablePtr,stablePtrTc,"StablePtr")+INSTANCE_TYPEABLE1(IORef,iORefTc,"IORef")++-------------------------------------------------------+--+-- Generate Typeable instances for standard datatypes+--+-------------------------------------------------------++INSTANCE_TYPEABLE0(Bool,boolTc,"Bool")+INSTANCE_TYPEABLE0(Char,charTc,"Char")+INSTANCE_TYPEABLE0(Float,floatTc,"Float")+INSTANCE_TYPEABLE0(Double,doubleTc,"Double")+INSTANCE_TYPEABLE0(Int,intTc,"Int")+#ifndef __NHC__+INSTANCE_TYPEABLE0(Word,wordTc,"Word" )+#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")+INSTANCE_TYPEABLE0(Int32,int32Tc,"Int32")+INSTANCE_TYPEABLE0(Int64,int64Tc,"Int64")++INSTANCE_TYPEABLE0(Word8,word8Tc,"Word8" )+INSTANCE_TYPEABLE0(Word16,word16Tc,"Word16")+INSTANCE_TYPEABLE0(Word32,word32Tc,"Word32")+INSTANCE_TYPEABLE0(Word64,word64Tc,"Word64")++INSTANCE_TYPEABLE0(TyCon,tyconTc,"TyCon")+INSTANCE_TYPEABLE0(TypeRep,typeRepTc,"TypeRep")++#ifdef __GLASGOW_HASKELL__+{-+TODO: This can't be derived currently:+libraries/base/Data/Typeable.hs:674:1:+    Can't make a derived instance of `Typeable RealWorld':+      The last argument of the instance must be a data or newtype application+    In the stand-alone deriving instance for `Typeable RealWorld'+-}+realWorldTc :: TyCon; \+realWorldTc = mkTyCon3 "ghc-prim" "GHC.Types" "RealWorld"; \+instance Typeable RealWorld where { typeOf _ = mkTyConApp realWorldTc [] }++#endif
+ Data/Typeable/Internal.hs-boot view
@@ -0,0 +1,26 @@+{-# LANGUAGE CPP, NoImplicitPrelude, MagicHash #-}+module Data.Typeable.Internal (+    Typeable(typeOf),+    TypeRep,+    TyCon,+    mkTyCon,+    mkTyConApp+  ) where++import GHC.Base++data TypeRep+data TyCon++#include "MachDeps.h"++#if WORD_SIZE_IN_BITS < 64+mkTyCon :: Word64# -> Word64# -> String -> String -> String -> TyCon+#else+mkTyCon :: Word#   -> Word#   -> String -> String -> String -> TyCon+#endif++mkTyConApp   :: TyCon -> [TypeRep] -> TypeRep++class Typeable a where+  typeOf :: a -> TypeRep
Data/Unique.hs view
@@ -1,3 +1,10 @@+{-# LANGUAGE Trustworthy #-}+{-# LANGUAGE CPP #-}++#ifdef __GLASGOW_HASKELL__+{-# LANGUAGE MagicHash, DeriveDataTypeable #-}+#endif+ ----------------------------------------------------------------------------- -- | -- Module      :  Data.Unique
Data/Version.hs view
@@ -1,3 +1,6 @@+{-# LANGUAGE Trustworthy #-}+{-# LANGUAGE CPP, DeriveDataTypeable #-}+ ----------------------------------------------------------------------------- -- | -- Module      :  Data.Version
Data/Word.hs view
@@ -1,4 +1,6 @@-{-# OPTIONS_GHC -XNoImplicitPrelude #-}+{-# LANGUAGE Safe #-}+{-# LANGUAGE CPP, NoImplicitPrelude #-}+ ----------------------------------------------------------------------------- -- | -- Module      :  Data.Word
Debug/Trace.hs view
@@ -1,3 +1,5 @@+{-# LANGUAGE CPP, ForeignFunctionInterface #-}+ ----------------------------------------------------------------------------- -- | -- Module      :  Debug.Trace
Foreign.hs view
@@ -1,4 +1,8 @@-{-# OPTIONS_GHC -XNoImplicitPrelude #-}+#if sh_SAFE_DEFAULT+{-# LANGUAGE Trustworthy #-}+#endif+{-# LANGUAGE NoImplicitPrelude #-}+ ----------------------------------------------------------------------------- -- | -- Module      :  Foreign@@ -24,11 +28,15 @@         , module Foreign.Storable         , module Foreign.Marshal +#if !sh_SAFE_DEFAULT+        -- * Unsafe Functions+         -- | 'unsafePerformIO' is exported here for backwards         -- compatibility reasons only.  For doing local marshalling in         -- the FFI, use 'unsafeLocalState'.  For other uses, see         -- 'System.IO.Unsafe.unsafePerformIO'.         , unsafePerformIO+#endif         ) where  import Data.Bits@@ -40,4 +48,14 @@ import Foreign.Storable import Foreign.Marshal -import System.IO.Unsafe (unsafePerformIO)+#if !sh_SAFE_DEFAULT+import GHC.IO (IO)+import qualified System.IO.Unsafe (unsafePerformIO)++{-# DEPRECATED unsafePerformIO "Use System.IO.Unsafe.unsafePerformIO instead; This function will be removed in the next release" #-}++{-# INLINE unsafePerformIO #-}+unsafePerformIO :: IO a -> a+unsafePerformIO = System.IO.Unsafe.unsafePerformIO+#endif+
Foreign/C.hs view
@@ -1,4 +1,6 @@-{-# OPTIONS_GHC -XNoImplicitPrelude #-}+{-# LANGUAGE Safe #-}+{-# LANGUAGE NoImplicitPrelude #-}+ ----------------------------------------------------------------------------- -- | -- Module      :  Foreign.C
Foreign/C/Error.hs view
@@ -1,4 +1,7 @@-{-# OPTIONS_GHC -XNoImplicitPrelude -#include "HsBase.h" #-}+{-# LANGUAGE Trustworthy #-}+{-# LANGUAGE CPP, NoImplicitPrelude, ForeignFunctionInterface #-}+{-# OPTIONS_GHC -#include "HsBase.h" #-}+ ----------------------------------------------------------------------------- -- | -- Module      :  Foreign.C.Error
Foreign/C/String.hs view
@@ -1,4 +1,6 @@-{-# OPTIONS_GHC -XNoImplicitPrelude #-}+{-# LANGUAGE Trustworthy #-}+{-# LANGUAGE CPP, NoImplicitPrelude #-}+ ----------------------------------------------------------------------------- -- | -- Module      :  Foreign.C.String@@ -22,7 +24,6 @@ -----------------------------------------------------------------------------  module Foreign.C.String (   -- representation of strings in C-   -- * C strings    CString,           -- = Ptr CChar@@ -30,8 +31,14 @@    -- ** Using a locale-dependent encoding +#ifndef __GLASGOW_HASKELL__   -- | Currently these functions are identical to their @CAString@ counterparts;   -- eventually they will use an encoding determined by the current locale.+#else+  -- | These functions are different from their @CAString@ counterparts+  -- in that they will use an encoding determined by the current locale,+  -- rather than always assuming ASCII.+#endif    -- conversion of C strings into Haskell strings   --@@ -101,10 +108,15 @@ import Data.Word  #ifdef __GLASGOW_HASKELL__+import Control.Monad+ import GHC.List import GHC.Real import GHC.Num import GHC.Base++import {-# SOURCE #-} GHC.IO.Encoding+import qualified GHC.Foreign as GHC #else import Data.Char ( chr, ord ) #define unsafeChr chr@@ -132,12 +144,20 @@ -- | Marshal a NUL terminated C string into a Haskell string. -- peekCString    :: CString -> IO String+#ifndef __GLASGOW_HASKELL__ peekCString = peekCAString+#else+peekCString = GHC.peekCString foreignEncoding+#endif  -- | Marshal a C string with explicit length into a Haskell string. -- peekCStringLen           :: CStringLen -> IO String+#ifndef __GLASGOW_HASKELL__ peekCStringLen = peekCAStringLen+#else+peekCStringLen = GHC.peekCStringLen foreignEncoding+#endif  -- | Marshal a Haskell string into a NUL terminated C string. --@@ -148,7 +168,11 @@ --   'Foreign.Marshal.Alloc.finalizerFree'. -- newCString :: String -> IO CString+#ifndef __GLASGOW_HASKELL__ newCString = newCAString+#else+newCString = GHC.newCString foreignEncoding+#endif  -- | Marshal a Haskell string into a C string (ie, character array) with -- explicit length information.@@ -158,7 +182,11 @@ --   'Foreign.Marshal.Alloc.finalizerFree'. -- newCStringLen     :: String -> IO CStringLen+#ifndef __GLASGOW_HASKELL__ newCStringLen = newCAStringLen+#else+newCStringLen = GHC.newCStringLen foreignEncoding+#endif  -- | Marshal a Haskell string into a NUL terminated C string using temporary -- storage.@@ -170,7 +198,11 @@ --   storage must /not/ be used after this. -- withCString :: String -> (CString -> IO a) -> IO a+#ifndef __GLASGOW_HASKELL__ withCString = withCAString+#else+withCString = GHC.withCString foreignEncoding+#endif  -- | Marshal a Haskell string into a C string (ie, character array) -- in temporary storage, with explicit length information.@@ -180,14 +212,26 @@ --   storage must /not/ be used after this. -- withCStringLen         :: String -> (CStringLen -> IO a) -> IO a+#ifndef __GLASGOW_HASKELL__ withCStringLen = withCAStringLen+#else+withCStringLen = GHC.withCStringLen foreignEncoding+#endif ++#ifndef __GLASGOW_HASKELL__ -- | Determines whether a character can be accurately encoded in a 'CString'. -- Unrepresentable characters are converted to @\'?\'@. -- -- Currently only Latin-1 characters are representable. charIsRepresentable :: Char -> IO Bool charIsRepresentable c = return (ord c < 256)+#else+-- -- | Determines whether a character can be accurately encoded in a 'CString'.+-- -- Unrepresentable characters are converted to '?' or their nearest visual equivalent.+charIsRepresentable :: Char -> IO Bool+charIsRepresentable = GHC.charIsRepresentable foreignEncoding+#endif  -- single byte characters -- ----------------------
Foreign/C/Types.hs view
@@ -1,7 +1,16 @@-{-# OPTIONS_GHC -XNoImplicitPrelude #-}+{-# LANGUAGE Trustworthy #-}+{-# LANGUAGE CPP+           , NoImplicitPrelude+           , MagicHash+           , GeneralizedNewtypeDeriving+  #-} {-# OPTIONS_GHC -fno-warn-unused-binds #-}+#ifdef __GLASGOW_HASKELL__+{-# LANGUAGE DeriveDataTypeable, StandaloneDeriving #-}+#endif -- XXX -fno-warn-unused-binds stops us warning about unused constructors, -- but really we should just remove them if we don't want them+ ----------------------------------------------------------------------------- -- | -- Module      :  Foreign.C.Types@@ -41,7 +50,7 @@           -- foreign types, and are instances of           -- 'Prelude.Eq', 'Prelude.Ord', 'Prelude.Num', 'Prelude.Read',           -- 'Prelude.Show', 'Prelude.Enum', 'Typeable' and 'Storable'.-        , CClock,   CTime+        , CClock,   CTime, CUSeconds, CSUSeconds          -- extracted from CTime, because we don't want this comment in         -- the Haskell 2010 report:@@ -65,13 +74,14 @@ #endif #else           -- Exported non-abstractly in nhc98 to fix an interface file problem.-          CChar(..),    CSChar(..),  CUChar(..)-        , CShort(..),   CUShort(..), CInt(..),   CUInt(..)+          CChar(..),    CSChar(..),   CUChar(..)+        , CShort(..),   CUShort(..),  CInt(..),      CUInt(..)         , CLong(..),    CULong(..)-        , CPtrdiff(..), CSize(..),   CWchar(..), CSigAtomic(..)+        , CPtrdiff(..), CSize(..),    CWchar(..),    CSigAtomic(..)         , CLLong(..),   CULLong(..)-        , CClock(..),   CTime(..)-        , CFloat(..),   CDouble(..), CLDouble(..)+        , CClock(..),   CTime(..),    CUSeconds(..), CSUSeconds(..)+        , CFloat(..),   CDouble(..),  CLDouble(..)+        , CIntPtr(..),  CUIntPtr(..), CIntMax(..),   CUIntMax(..) #endif           -- ** Other types @@ -85,7 +95,9 @@ import Data.Bits        ( Bits(..) ) import Data.Int         ( Int8,  Int16,  Int32,  Int64  ) import Data.Word        ( Word8, Word16, Word32, Word64 )-import {-# SOURCE #-} Data.Typeable (Typeable(typeOf), TyCon, mkTyCon, mkTyConApp)+import {-# SOURCE #-} Data.Typeable+  -- loop: Data.Typeable -> Data.List -> Data.Char -> GHC.Unicode+  --            -> Foreign.C.Type  #ifdef __GLASGOW_HASKELL__ import GHC.Base@@ -206,8 +218,11 @@ -- | Haskell type representing the C @clock_t@ type. ARITHMETIC_TYPE(CClock,tyConCClock,"CClock",HTYPE_CLOCK_T) -- | Haskell type representing the C @time_t@ type.--- ARITHMETIC_TYPE(CTime,tyConCTime,"CTime",HTYPE_TIME_T)+-- | Haskell type representing the C @useconds_t@ type.+ARITHMETIC_TYPE(CUSeconds,tyConCUSeconds,"CUSeconds",HTYPE_USECONDS_T)+-- | Haskell type representing the C @suseconds_t@ type.+ARITHMETIC_TYPE(CSUSeconds,tyConCSUSeconds,"CSUSeconds",HTYPE_SUSECONDS_T)  -- FIXME: Implement and provide instances for Eq and Storable -- | Haskell type representing the C @FILE@ type.@@ -278,13 +293,14 @@ #else   /* __NHC__ */  import NHC.FFI-  ( CChar(..),    CSChar(..),  CUChar(..)-  , CShort(..),   CUShort(..), CInt(..),   CUInt(..)-  , CLong(..),    CULong(..),  CLLong(..), CULLong(..)-  , CPtrdiff(..), CSize(..),   CWchar(..), CSigAtomic(..)-  , CClock(..),   CTime(..)-  , CFloat(..),   CDouble(..), CLDouble(..)-  , CFile,        CFpos,       CJmpBuf+  ( CChar(..),    CSChar(..),   CUChar(..)+  , CShort(..),   CUShort(..),  CInt(..),      CUInt(..)+  , CLong(..),    CULong(..),   CLLong(..),    CULLong(..)+  , CPtrdiff(..), CSize(..),    CWchar(..),    CSigAtomic(..)+  , CClock(..),   CTime(..),    CUSeconds(..), CSUSeconds(..)+  , CFloat(..),   CDouble(..),  CLDouble(..)+  , CIntPtr(..),  CUIntPtr(..), CIntMax(..),   CUIntMax(..)+  , CFile,        CFpos,        CJmpBuf   , Storable(..)   ) import Data.Bits@@ -321,5 +337,9 @@ INSTANCE_BITS(CWchar) INSTANCE_BITS(CSigAtomic) INSTANCE_BITS(CSize)+INSTANCE_BITS(CIntPtr)+INSTANCE_BITS(CUIntPtr)+INSTANCE_BITS(CIntMax)+INSTANCE_BITS(CUIntMax)  #endif
Foreign/Concurrent.hs view
@@ -1,4 +1,6 @@-{-# OPTIONS_GHC -XNoImplicitPrelude #-}+{-# LANGUAGE Trustworthy #-}+{-# LANGUAGE CPP, NoImplicitPrelude #-}+ ----------------------------------------------------------------------------- -- | -- Module      :  Foreign.Concurrent@@ -28,13 +30,11 @@   ) where  #ifdef __GLASGOW_HASKELL__-import GHC.IO           ( IO )-import GHC.Ptr          ( Ptr )-import GHC.ForeignPtr   ( ForeignPtr )+import GHC.IO         ( IO )+import GHC.Ptr        ( Ptr )+import GHC.ForeignPtr ( ForeignPtr ) import qualified GHC.ForeignPtr-#endif -#ifdef __GLASGOW_HASKELL__ newForeignPtr :: Ptr a -> IO () -> IO (ForeignPtr a) -- ^Turns a plain memory reference into a foreign object by associating -- a finalizer - given by the monadic operation - with the reference.@@ -51,3 +51,4 @@ -- same object. addForeignPtrFinalizer = GHC.ForeignPtr.addForeignPtrConcFinalizer #endif+
Foreign/ForeignPtr.hs view
@@ -1,4 +1,9 @@-{-# OPTIONS_GHC -XNoImplicitPrelude #-}+{-# LANGUAGE SafeImports, CPP, NoImplicitPrelude #-}+#if sh_SAFE_DEFAULT+{-# LANGUAGE Trustworthy #-}+#endif+{-# OPTIONS_HADDOCK hide #-}+ ----------------------------------------------------------------------------- -- | -- Module      :  Foreign.ForeignPtr@@ -15,165 +20,23 @@ -- ----------------------------------------------------------------------------- -module Foreign.ForeignPtr-        ( -        -- * Finalised data pointers-          ForeignPtr-        , FinalizerPtr-#if defined(__HUGS__) || defined(__GLASGOW_HASKELL__)-        , FinalizerEnvPtr-#endif-        -- ** Basic operations-        , newForeignPtr-        , newForeignPtr_-        , addForeignPtrFinalizer-#if defined(__HUGS__) || defined(__GLASGOW_HASKELL__)-        , newForeignPtrEnv-        , addForeignPtrFinalizerEnv-#endif-        , withForeignPtr--#ifdef __GLASGOW_HASKELL__-        , finalizeForeignPtr-#endif--        -- ** Low-level operations+module Foreign.ForeignPtr ( +          module Foreign.ForeignPtr.Safe+#if !sh_SAFE_DEFAULT+        -- ** Unsafe low-level operations         , unsafeForeignPtrToPtr-        , touchForeignPtr-        , castForeignPtr--        -- ** Allocating managed memory-        , mallocForeignPtr-        , mallocForeignPtrBytes-        , mallocForeignPtrArray-        , mallocForeignPtrArray0-        ) -        where--import Foreign.Ptr--#ifdef __NHC__-import NHC.FFI-  ( ForeignPtr-  , FinalizerPtr-  , newForeignPtr-  , newForeignPtr_-  , addForeignPtrFinalizer-  , withForeignPtr-  , unsafeForeignPtrToPtr-  , touchForeignPtr-  , castForeignPtr-  , Storable(sizeOf)-  , malloc, mallocBytes, finalizerFree-  ) #endif--#ifdef __HUGS__-import Hugs.ForeignPtr-#endif--#ifndef __NHC__-import Foreign.Storable ( Storable(sizeOf) )-#endif--#ifdef __GLASGOW_HASKELL__-import GHC.Base--- import GHC.IO-import GHC.Num-import GHC.Err          ( undefined )-import GHC.ForeignPtr-#endif--#if !defined(__NHC__) && !defined(__GLASGOW_HASKELL__)-import Foreign.Marshal.Alloc    ( malloc, mallocBytes, finalizerFree )+    ) where -instance Eq (ForeignPtr a) where -    p == q  =  unsafeForeignPtrToPtr p == unsafeForeignPtrToPtr q+import safe Foreign.ForeignPtr.Safe -instance Ord (ForeignPtr a) where -    compare p q  =  compare (unsafeForeignPtrToPtr p) (unsafeForeignPtrToPtr q)+#if !sh_SAFE_DEFAULT+import Foreign.Ptr ( Ptr )+import qualified Foreign.ForeignPtr.Unsafe as U -instance Show (ForeignPtr a) where-    showsPrec p f = showsPrec p (unsafeForeignPtrToPtr f)+{-# DEPRECATED unsafeForeignPtrToPtr "Use Foreign.ForeignPtr.Unsafe.unsafeForeignPtrToPtr instead; This function will be removed in the next release" #-}+{-# INLINE unsafeForeignPtrToPtr #-}+unsafeForeignPtrToPtr :: ForeignPtr a -> Ptr a+unsafeForeignPtrToPtr = U.unsafeForeignPtrToPtr #endif --#ifndef __NHC__-newForeignPtr :: FinalizerPtr a -> Ptr a -> IO (ForeignPtr a)--- ^Turns a plain memory reference into a foreign pointer, and--- associates a finalizer with the reference.  The finalizer 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-       return fObj--withForeignPtr :: ForeignPtr a -> (Ptr a -> IO b) -> IO b--- ^This is a way to look at the pointer living inside a--- foreign object.  This function takes a function which is--- applied to that pointer. The resulting 'IO' action is then--- executed. The foreign object is kept alive at least during--- the whole action, even if it is not used directly--- inside. Note that it is not safe to return the pointer from--- the action and use it after the action completes. All uses--- of the pointer should be inside the--- 'withForeignPtr' bracket.  The reason for--- this unsafeness is the same as for--- 'unsafeForeignPtrToPtr' below: the finalizer--- may run earlier than expected, because the compiler can only--- track usage of the 'ForeignPtr' object, not--- a 'Ptr' object made from it.------ This function is normally used for marshalling data to--- or from the object pointed to by the--- 'ForeignPtr', using the operations from the--- 'Storable' class.-withForeignPtr fo io-  = do r <- io (unsafeForeignPtrToPtr fo)-       touchForeignPtr fo-       return r-#endif /* ! __NHC__ */--#if defined(__HUGS__) || defined(__GLASGOW_HASKELL__)--- | This variant of 'newForeignPtr' adds a finalizer that expects an--- environment in addition to the finalized pointer.  The environment--- that will be passed to the finalizer is fixed by the second argument to--- 'newForeignPtrEnv'.-newForeignPtrEnv ::-    FinalizerEnvPtr env a -> Ptr env -> Ptr a -> IO (ForeignPtr a)-newForeignPtrEnv finalizer env p-  = do fObj <- newForeignPtr_ p-       addForeignPtrFinalizerEnv finalizer env fObj-       return fObj-#endif /* __HUGS__ */--#ifndef __GLASGOW_HASKELL__-mallocForeignPtr :: Storable a => IO (ForeignPtr a)-mallocForeignPtr = do-  r <- malloc-  newForeignPtr finalizerFree r--mallocForeignPtrBytes :: Int -> IO (ForeignPtr a)-mallocForeignPtrBytes n = do-  r <- mallocBytes n-  newForeignPtr finalizerFree r-#endif /* !__GLASGOW_HASKELL__ */---- | This function is similar to 'Foreign.Marshal.Array.mallocArray',--- but yields a memory area that has a finalizer attached that releases--- the memory area.  As with 'mallocForeignPtr', it is not guaranteed that--- the block of memory was allocated by 'Foreign.Marshal.Alloc.malloc'.-mallocForeignPtrArray :: Storable a => Int -> IO (ForeignPtr a)-mallocForeignPtrArray  = doMalloc undefined-  where-    doMalloc            :: Storable b => b -> Int -> IO (ForeignPtr b)-    doMalloc dummy size  = mallocForeignPtrBytes (size * sizeOf dummy)---- | This function is similar to 'Foreign.Marshal.Array.mallocArray0',--- but yields a memory area that has a finalizer attached that releases--- the memory area.  As with 'mallocForeignPtr', it is not guaranteed that--- the block of memory was allocated by 'Foreign.Marshal.Alloc.malloc'.-mallocForeignPtrArray0      :: Storable a => Int -> IO (ForeignPtr a)-mallocForeignPtrArray0 size  = mallocForeignPtrArray (size + 1)
+ Foreign/ForeignPtr/Imp.hs view
@@ -0,0 +1,180 @@+{-# LANGUAGE CPP, NoImplicitPrelude #-}+{-# OPTIONS_HADDOCK hide #-}++-----------------------------------------------------------------------------+-- |+-- Module      :  Foreign.ForeignPtr.Imp+-- Copyright   :  (c) The University of Glasgow 2001+-- License     :  BSD-style (see the file libraries/base/LICENSE)+-- +-- Maintainer  :  ffi@haskell.org+-- Stability   :  provisional+-- Portability :  portable+--+-- The 'ForeignPtr' type and operations.  This module is part of the+-- Foreign Function Interface (FFI) and will usually be imported via+-- the "Foreign" module.+--+-----------------------------------------------------------------------------++module Foreign.ForeignPtr.Imp+        ( +        -- * Finalised data pointers+          ForeignPtr+        , FinalizerPtr+#if defined(__HUGS__) || defined(__GLASGOW_HASKELL__)+        , FinalizerEnvPtr+#endif+        -- ** Basic operations+        , newForeignPtr+        , newForeignPtr_+        , addForeignPtrFinalizer+#if defined(__HUGS__) || defined(__GLASGOW_HASKELL__)+        , newForeignPtrEnv+        , addForeignPtrFinalizerEnv+#endif+        , withForeignPtr++#ifdef __GLASGOW_HASKELL__+        , finalizeForeignPtr+#endif++        -- ** Low-level operations+        , unsafeForeignPtrToPtr+        , touchForeignPtr+        , castForeignPtr++        -- ** Allocating managed memory+        , mallocForeignPtr+        , mallocForeignPtrBytes+        , mallocForeignPtrArray+        , mallocForeignPtrArray0+        ) +        where++import Foreign.Ptr++#ifdef __NHC__+import NHC.FFI+  ( ForeignPtr+  , FinalizerPtr+  , newForeignPtr+  , newForeignPtr_+  , addForeignPtrFinalizer+  , withForeignPtr+  , unsafeForeignPtrToPtr+  , touchForeignPtr+  , castForeignPtr+  , Storable(sizeOf)+  , malloc, mallocBytes, finalizerFree+  )+#endif++#ifdef __HUGS__+import Hugs.ForeignPtr+#endif++#ifndef __NHC__+import Foreign.Storable ( Storable(sizeOf) )+#endif++#ifdef __GLASGOW_HASKELL__+import GHC.Base+import GHC.Num+import GHC.Err          ( undefined )+import GHC.ForeignPtr+#endif++#if !defined(__NHC__) && !defined(__GLASGOW_HASKELL__)+import Foreign.Marshal.Alloc    ( malloc, mallocBytes, finalizerFree )++instance Eq (ForeignPtr a) where +    p == q  =  unsafeForeignPtrToPtr p == unsafeForeignPtrToPtr q++instance Ord (ForeignPtr a) where +    compare p q  =  compare (unsafeForeignPtrToPtr p) (unsafeForeignPtrToPtr q)++instance Show (ForeignPtr a) where+    showsPrec p f = showsPrec p (unsafeForeignPtrToPtr f)+#endif+++#ifndef __NHC__+newForeignPtr :: FinalizerPtr a -> Ptr a -> IO (ForeignPtr a)+-- ^Turns a plain memory reference into a foreign pointer, and+-- associates a finalizer with the reference.  The finalizer 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+       return fObj++withForeignPtr :: ForeignPtr a -> (Ptr a -> IO b) -> IO b+-- ^This is a way to look at the pointer living inside a+-- foreign object.  This function takes a function which is+-- applied to that pointer. The resulting 'IO' action is then+-- executed. The foreign object is kept alive at least during+-- the whole action, even if it is not used directly+-- inside. Note that it is not safe to return the pointer from+-- the action and use it after the action completes. All uses+-- of the pointer should be inside the+-- 'withForeignPtr' bracket.  The reason for+-- this unsafeness is the same as for+-- 'unsafeForeignPtrToPtr' below: the finalizer+-- may run earlier than expected, because the compiler can only+-- track usage of the 'ForeignPtr' object, not+-- a 'Ptr' object made from it.+--+-- This function is normally used for marshalling data to+-- or from the object pointed to by the+-- 'ForeignPtr', using the operations from the+-- 'Storable' class.+withForeignPtr fo io+  = do r <- io (unsafeForeignPtrToPtr fo)+       touchForeignPtr fo+       return r+#endif /* ! __NHC__ */++#if defined(__HUGS__) || defined(__GLASGOW_HASKELL__)+-- | This variant of 'newForeignPtr' adds a finalizer that expects an+-- environment in addition to the finalized pointer.  The environment+-- that will be passed to the finalizer is fixed by the second argument to+-- 'newForeignPtrEnv'.+newForeignPtrEnv ::+    FinalizerEnvPtr env a -> Ptr env -> Ptr a -> IO (ForeignPtr a)+newForeignPtrEnv finalizer env p+  = do fObj <- newForeignPtr_ p+       addForeignPtrFinalizerEnv finalizer env fObj+       return fObj+#endif /* __HUGS__ */++#ifndef __GLASGOW_HASKELL__+mallocForeignPtr :: Storable a => IO (ForeignPtr a)+mallocForeignPtr = do+  r <- malloc+  newForeignPtr finalizerFree r++mallocForeignPtrBytes :: Int -> IO (ForeignPtr a)+mallocForeignPtrBytes n = do+  r <- mallocBytes n+  newForeignPtr finalizerFree r+#endif /* !__GLASGOW_HASKELL__ */++-- | This function is similar to 'Foreign.Marshal.Array.mallocArray',+-- but yields a memory area that has a finalizer attached that releases+-- the memory area.  As with 'mallocForeignPtr', it is not guaranteed that+-- the block of memory was allocated by 'Foreign.Marshal.Alloc.malloc'.+mallocForeignPtrArray :: Storable a => Int -> IO (ForeignPtr a)+mallocForeignPtrArray  = doMalloc undefined+  where+    doMalloc            :: Storable b => b -> Int -> IO (ForeignPtr b)+    doMalloc dummy size  = mallocForeignPtrBytes (size * sizeOf dummy)++-- | This function is similar to 'Foreign.Marshal.Array.mallocArray0',+-- but yields a memory area that has a finalizer attached that releases+-- the memory area.  As with 'mallocForeignPtr', it is not guaranteed that+-- the block of memory was allocated by 'Foreign.Marshal.Alloc.malloc'.+mallocForeignPtrArray0      :: Storable a => Int -> IO (ForeignPtr a)+mallocForeignPtrArray0 size  = mallocForeignPtrArray (size + 1)
+ Foreign/ForeignPtr/Safe.hs view
@@ -0,0 +1,55 @@+{-# LANGUAGE Trustworthy #-}+{-# LANGUAGE CPP, NoImplicitPrelude #-}++-----------------------------------------------------------------------------+-- |+-- Module      :  Foreign.ForeignPtr.Safe+-- Copyright   :  (c) The University of Glasgow 2001+-- License     :  BSD-style (see the file libraries/base/LICENSE)+-- +-- Maintainer  :  ffi@haskell.org+-- Stability   :  provisional+-- Portability :  portable+--+-- The 'ForeignPtr' type and operations.  This module is part of the+-- Foreign Function Interface (FFI) and will usually be imported via+-- the "Foreign" module.+--+-- Safe API Only.+--+-----------------------------------------------------------------------------++module Foreign.ForeignPtr.Safe (+        -- * Finalised data pointers+          ForeignPtr+        , FinalizerPtr+#if defined(__HUGS__) || defined(__GLASGOW_HASKELL__)+        , FinalizerEnvPtr+#endif+        -- ** Basic operations+        , newForeignPtr+        , newForeignPtr_+        , addForeignPtrFinalizer+#if defined(__HUGS__) || defined(__GLASGOW_HASKELL__)+        , newForeignPtrEnv+        , addForeignPtrFinalizerEnv+#endif+        , withForeignPtr++#ifdef __GLASGOW_HASKELL__+        , finalizeForeignPtr+#endif++        -- ** Low-level operations+        , touchForeignPtr+        , castForeignPtr++        -- ** Allocating managed memory+        , mallocForeignPtr+        , mallocForeignPtrBytes+        , mallocForeignPtrArray+        , mallocForeignPtrArray0+    ) where++import Foreign.ForeignPtr.Imp+
+ Foreign/ForeignPtr/Unsafe.hs view
@@ -0,0 +1,28 @@+{-# LANGUAGE Trustworthy #-}+{-# LANGUAGE CPP, NoImplicitPrelude #-}++-----------------------------------------------------------------------------+-- |+-- Module      :  Foreign.ForeignPtr.Unsafe+-- Copyright   :  (c) The University of Glasgow 2001+-- License     :  BSD-style (see the file libraries/base/LICENSE)+-- +-- Maintainer  :  ffi@haskell.org+-- Stability   :  provisional+-- Portability :  portable+--+-- The 'ForeignPtr' type and operations.  This module is part of the+-- Foreign Function Interface (FFI) and will usually be imported via+-- the "Foreign" module.+--+-- Unsafe API Only.+--+-----------------------------------------------------------------------------++module Foreign.ForeignPtr.Unsafe (+        -- ** Unsafe low-level operations+        unsafeForeignPtrToPtr,+    ) where++import Foreign.ForeignPtr.Imp+
Foreign/Marshal.hs view
@@ -1,4 +1,5 @@-{-# OPTIONS_GHC -XNoImplicitPrelude #-}+{-# LANGUAGE CPP, NoImplicitPrelude #-}+ ----------------------------------------------------------------------------- -- | -- Module      :  Foreign.Marshal@@ -15,22 +16,14 @@  module Foreign.Marshal         (-         -- | The module "Foreign.Marshal" re-exports the other modules in the+         -- | The module "Foreign.Marshal" re-exports the safe content in the          -- @Foreign.Marshal@ hierarchy:-          module Foreign.Marshal.Alloc-        , module Foreign.Marshal.Array-        , module Foreign.Marshal.Error-        , module Foreign.Marshal.Pool-        , module Foreign.Marshal.Utils+          module Foreign.Marshal.Safe          -- | and provides one function:         , unsafeLocalState         ) where -import Foreign.Marshal.Alloc-import Foreign.Marshal.Array-import Foreign.Marshal.Error-import Foreign.Marshal.Pool-import Foreign.Marshal.Utils+import Foreign.Marshal.Safe  #ifdef __GLASGOW_HASKELL__ import GHC.IO@@ -56,5 +49,9 @@ It is expected that this operation will be replaced in a future revision of Haskell. -}+{-# DEPRECATED unsafeLocalState+               "Please import from Foreign.Marshall.Unsafe instead; This will be removed in the next release"+ #-} unsafeLocalState :: IO a -> a unsafeLocalState = unsafePerformIO+
Foreign/Marshal/Alloc.hs view
@@ -1,4 +1,11 @@-{-# OPTIONS_GHC -XNoImplicitPrelude #-}+{-# LANGUAGE Trustworthy #-}+{-# LANGUAGE CPP+           , NoImplicitPrelude+           , MagicHash+           , UnboxedTuples+           , ForeignFunctionInterface+  #-}+ ----------------------------------------------------------------------------- -- | -- Module      :  Foreign.Marshal.Alloc@@ -16,8 +23,9 @@ -- foreign functions or to provide space in which compound result values -- are obtained from foreign functions. -- --- If any of the allocation functions fails, a value of 'nullPtr' is--- produced.  If 'free' or 'reallocBytes' is applied to a memory area+-- If any of the allocation functions fails, an exception is thrown.+-- In some cases, memory exhaustion may mean the process is terminated.+-- If 'free' or 'reallocBytes' is applied to a memory area -- that has been allocated with 'alloca' or 'allocaBytes', the -- behaviour is undefined.  Any further access to memory areas allocated with -- 'alloca' or 'allocaBytes', after the computation that was passed to
Foreign/Marshal/Array.hs view
@@ -1,4 +1,6 @@-{-# OPTIONS_GHC -XNoImplicitPrelude #-}+{-# LANGUAGE Trustworthy #-}+{-# LANGUAGE CPP, NoImplicitPrelude, MagicHash #-}+ ----------------------------------------------------------------------------- -- | -- Module      :  Foreign.Marshal.Array
Foreign/Marshal/Error.hs view
@@ -1,4 +1,6 @@-{-# OPTIONS_GHC -XNoImplicitPrelude #-}+{-# LANGUAGE Trustworthy #-}+{-# LANGUAGE CPP, NoImplicitPrelude #-}+ ----------------------------------------------------------------------------- -- | -- Module      :  Foreign.Marshal.Error@@ -37,7 +39,6 @@ #endif import GHC.Base import GHC.Num--- import GHC.IO import GHC.IO.Exception #endif
Foreign/Marshal/Pool.hs view
@@ -1,4 +1,6 @@-{-# OPTIONS_GHC -XNoImplicitPrelude #-}+{-# LANGUAGE Trustworthy #-}+{-# LANGUAGE CPP, NoImplicitPrelude #-}+ -------------------------------------------------------------------------------- -- | -- Module      :  Foreign.Marshal.Pool
+ Foreign/Marshal/Safe.hs view
@@ -0,0 +1,36 @@+{-# LANGUAGE Safe #-}+{-# LANGUAGE CPP, NoImplicitPrelude #-}++-----------------------------------------------------------------------------+-- |+-- Module      :  Foreign.Marshal.Safe+-- Copyright   :  (c) The FFI task force 2003+-- License     :  BSD-style (see the file libraries/base/LICENSE)+-- +-- Maintainer  :  ffi@haskell.org+-- Stability   :  provisional+-- Portability :  portable+--+-- Marshalling support+--+-- Safe API Only.+--+-----------------------------------------------------------------------------++module Foreign.Marshal.Safe+        (+         -- | The module "Foreign.Marshal.Safe" re-exports the other modules in the+         -- @Foreign.Marshal@ hierarchy:+          module Foreign.Marshal.Alloc+        , module Foreign.Marshal.Array+        , module Foreign.Marshal.Error+        , module Foreign.Marshal.Pool+        , module Foreign.Marshal.Utils+        ) where++import Foreign.Marshal.Alloc+import Foreign.Marshal.Array+import Foreign.Marshal.Error+import Foreign.Marshal.Pool+import Foreign.Marshal.Utils+
+ Foreign/Marshal/Unsafe.hs view
@@ -0,0 +1,49 @@+{-# LANGUAGE Trustworthy #-}+{-# LANGUAGE CPP, NoImplicitPrelude #-}++-----------------------------------------------------------------------------+-- |+-- Module      :  Foreign.Marshal.Unsafe+-- Copyright   :  (c) The FFI task force 2003+-- License     :  BSD-style (see the file libraries/base/LICENSE)+-- +-- Maintainer  :  ffi@haskell.org+-- Stability   :  provisional+-- Portability :  portable+--+-- Marshalling support. Unsafe API.+--+-----------------------------------------------------------------------------++module Foreign.Marshal.Unsafe (+        -- * Unsafe functions+        unsafeLocalState+    ) where++#ifdef __GLASGOW_HASKELL__+import GHC.IO+#else+import System.IO.Unsafe+#endif++{- |+Sometimes an external entity is a pure function, except that it passes+arguments and/or results via pointers.  The function+@unsafeLocalState@ permits the packaging of such entities as pure+functions.  ++The only IO operations allowed in the IO action passed to+@unsafeLocalState@ are (a) local allocation (@alloca@, @allocaBytes@+and derived operations such as @withArray@ and @withCString@), and (b)+pointer operations (@Foreign.Storable@ and @Foreign.Ptr@) on the+pointers to local storage, and (c) foreign functions whose only+observable effect is to read and/or write the locally allocated+memory.  Passing an IO operation that does not obey these rules+results in undefined behaviour.++It is expected that this operation will be+replaced in a future revision of Haskell.+-}+unsafeLocalState :: IO a -> a+unsafeLocalState = unsafeDupablePerformIO+
Foreign/Marshal/Utils.hs view
@@ -1,4 +1,6 @@-{-# OPTIONS_GHC -XNoImplicitPrelude #-}+{-# LANGUAGE Trustworthy #-}+{-# LANGUAGE CPP, NoImplicitPrelude, ForeignFunctionInterface #-}+ ----------------------------------------------------------------------------- -- | -- Module      :  Foreign.Marshal.Utils@@ -117,8 +119,8 @@ -- -- * the 'nullPtr' is used to represent 'Nothing' ---maybeNew :: (      a -> IO (Ptr a))-         -> (Maybe a -> IO (Ptr a))+maybeNew :: (      a -> IO (Ptr b))+         -> (Maybe a -> IO (Ptr b)) maybeNew  = maybe (return nullPtr)  -- |Converts a @withXXX@ combinator into one marshalling a value wrapped
Foreign/Ptr.hs view
@@ -1,4 +1,14 @@-{-# OPTIONS_GHC -XNoImplicitPrelude #-}+{-# LANGUAGE Trustworthy #-}+{-# LANGUAGE CPP+           , NoImplicitPrelude+           , ForeignFunctionInterface+           , MagicHash+           , GeneralizedNewtypeDeriving+  #-}+#ifdef __GLASGOW_HASKELL__+{-# LANGUAGE DeriveDataTypeable, StandaloneDeriving #-}+#endif+ ----------------------------------------------------------------------------- -- | -- Module      :  Foreign.Ptr@@ -58,7 +68,6 @@ import GHC.Enum import GHC.Word         ( Word(..) ) --- import Data.Int import Data.Word #else import Control.Monad    ( liftM )
+ Foreign/Safe.hs view
@@ -0,0 +1,40 @@+{-# LANGUAGE Safe #-}+{-# LANGUAGE NoImplicitPrelude #-}++-----------------------------------------------------------------------------+-- |+-- Module      :  Foreign.Safe+-- Copyright   :  (c) The FFI task force 2001+-- License     :  BSD-style (see the file libraries/base/LICENSE)+-- +-- Maintainer  :  ffi@haskell.org+-- Stability   :  provisional+-- Portability :  portable+--+-- A collection of data types, classes, and functions for interfacing+-- with another programming language.+--+-- Safe API Only.+--+-----------------------------------------------------------------------------++module Foreign.Safe+        ( module Data.Bits+        , module Data.Int+        , module Data.Word+        , module Foreign.Ptr+        , module Foreign.ForeignPtr.Safe+        , module Foreign.StablePtr+        , module Foreign.Storable+        , module Foreign.Marshal.Safe+        ) where++import Data.Bits+import Data.Int+import Data.Word+import Foreign.Ptr+import Foreign.ForeignPtr.Safe+import Foreign.StablePtr+import Foreign.Storable+import Foreign.Marshal.Safe+
Foreign/StablePtr.hs view
@@ -1,4 +1,6 @@-{-# OPTIONS_GHC -XNoImplicitPrelude #-}+{-# LANGUAGE Trustworthy #-}+{-# LANGUAGE CPP, NoImplicitPrelude #-}+ ----------------------------------------------------------------------------- -- | -- Module      :  Foreign.StablePtr
Foreign/Storable.hs view
@@ -1,4 +1,9 @@-{-# OPTIONS_GHC -XNoImplicitPrelude #-}+{-# LANGUAGE Trustworthy #-}+{-# LANGUAGE CPP, NoImplicitPrelude, ScopedTypeVariables #-}+#ifdef __GLASGOW_HASKELL__+{-# LANGUAGE BangPatterns #-}+#endif+ ----------------------------------------------------------------------------- -- | -- Module      :  Foreign.Storable@@ -49,6 +54,9 @@ import GHC.Ptr import GHC.Err import GHC.Base+import GHC.Fingerprint.Type+import Data.Bits+import GHC.Real #else import Data.Int import Data.Word@@ -241,4 +249,38 @@ STORABLE(Int64,SIZEOF_INT64,ALIGNMENT_INT64,          readInt64OffPtr,writeInt64OffPtr) +#endif++-- XXX: here to avoid orphan instance in GHC.Fingerprint+#ifdef __GLASGOW_HASKELL__+instance Storable Fingerprint where+  sizeOf _ = 16+  alignment _ = 8+  peek = peekFingerprint+  poke = pokeFingerprint++-- peek/poke in fixed BIG-endian 128-bit format+peekFingerprint :: Ptr Fingerprint -> IO Fingerprint+peekFingerprint p0 = do+      let peekW64 :: Ptr Word8 -> Int -> Word64 -> IO Word64+          peekW64 _  0  !i = return i+          peekW64 !p !n !i = do+                w8 <- peek p+                peekW64 (p `plusPtr` 1) (n-1) +                    ((i `shiftL` 8) .|. fromIntegral w8)++      high <- peekW64 (castPtr p0) 8 0+      low  <- peekW64 (castPtr p0 `plusPtr` 8) 8 0+      return (Fingerprint high low)++pokeFingerprint :: Ptr Fingerprint -> Fingerprint -> IO ()+pokeFingerprint p0 (Fingerprint high low) = do+      let pokeW64 :: Ptr Word8 -> Int -> Word64 -> IO ()+          pokeW64 _ 0  _  = return ()+          pokeW64 p !n !i = do+                pokeElemOff p (n-1) (fromIntegral i)+                pokeW64 p (n-1) (i `shiftR` 8)++      pokeW64 (castPtr p0) 8 high+      pokeW64 (castPtr p0 `plusPtr` 8) 8 low #endif
GHC/Arr.lhs view
@@ -1,7 +1,8 @@ \begin{code}+{-# LANGUAGE NoImplicitPrelude, NoBangPatterns, MagicHash, UnboxedTuples #-} {-# OPTIONS_GHC -funbox-strict-fields #-}-{-# LANGUAGE NoImplicitPrelude, NoBangPatterns #-} {-# OPTIONS_HADDOCK hide #-}+ ----------------------------------------------------------------------------- -- | -- Module      :  GHC.Arr@@ -17,8 +18,29 @@ -----------------------------------------------------------------------------  -- #hide-module GHC.Arr where+module GHC.Arr (+        Ix(..), Array(..), STArray(..), +        indexError, hopelessIndexError,+        arrEleBottom, array, listArray,+        (!), safeRangeSize, negRange, safeIndex, badSafeIndex,+        bounds, numElements, numElementsSTArray, indices, elems,+        assocs, accumArray, adjust, (//), accum,+        amap, ixmap,+        eqArray, cmpArray, cmpIntArray,+        newSTArray, boundsSTArray,+        readSTArray, writeSTArray,+        freezeSTArray, thawSTArray,++        -- * Unsafe operations+        fill, done,+        unsafeArray, unsafeArray',+        lessSafeIndex, unsafeAt, unsafeReplace,+        unsafeAccumArray, unsafeAccumArray', unsafeAccum,+        unsafeReadSTArray, unsafeWriteSTArray,+        unsafeFreezeSTArray, unsafeThawSTArray,+    ) where+ import GHC.Enum import GHC.Num import GHC.ST@@ -350,17 +372,15 @@ %*********************************************************  \begin{code}-type IPr = (Int, Int)- -- | The type of immutable non-strict (boxed) arrays -- with indices in @i@ and elements in @e@.-data Ix i => Array i e-                 = Array !i         -- the lower bound, l-                         !i         -- the upper bound, u-                         !Int       -- a cache of (rangeSize (l,u))-                                    -- used to make sure an index is-                                    -- really in range-                         (Array# e) -- The actual elements+data Array i e+         = Array !i         -- the lower bound, l+                 !i         -- the upper bound, u+                 !Int       -- a cache of (rangeSize (l,u))+                            -- used to make sure an index is+                            -- really in range+                 (Array# e) -- The actual elements  -- | Mutable, boxed, non-strict arrays in the 'ST' monad.  The type -- arguments are as follows:
GHC/Base.lhs view
@@ -62,11 +62,20 @@ Other Prelude modules are much easier with fewer complex dependencies.  \begin{code}-{-# OPTIONS_GHC -XNoImplicitPrelude #-}+{-# LANGUAGE CPP+           , NoImplicitPrelude+           , BangPatterns+           , ExplicitForAll+           , MagicHash+           , UnboxedTuples+           , ExistentialQuantification+           , Rank2Types+  #-} -- -fno-warn-orphans is needed for things like: -- Orphan rule: "x# -# x#" ALWAYS forall x# :: Int# -# x# x# = 0 {-# OPTIONS_GHC -fno-warn-orphans #-} {-# OPTIONS_HADDOCK hide #-}+ ----------------------------------------------------------------------------- -- | -- Module      :  GHC.Base@@ -87,9 +96,8 @@ module GHC.Base         (         module GHC.Base,-        module GHC.Bool,         module GHC.Classes,-        module GHC.Generics,+        module GHC.CString,         module GHC.Ordering,         module GHC.Types,         module GHC.Prim,        -- Re-export GHC.Prim and GHC.Err, to avoid lots@@ -98,9 +106,8 @@         where  import GHC.Types-import GHC.Bool import GHC.Classes-import GHC.Generics+import GHC.CString import GHC.Ordering import GHC.Prim import {-# SOURCE #-} GHC.Show@@ -146,15 +153,6 @@  build = error "urk" foldr = error "urk"--unpackCString# :: Addr# -> [Char]-unpackFoldrCString# :: Addr# -> (Char  -> a -> a) -> a -> a -unpackAppendCString# :: Addr# -> [Char] -> [Char]-unpackCStringUtf8# :: Addr# -> [Char]-unpackCString# a = error "urk"-unpackFoldrCString# a = error "urk"-unpackAppendCString# a = error "urk"-unpackCStringUtf8# a = error "urk" -} \end{code} @@ -500,26 +498,6 @@ minInt  = I# (-0x8000000000000000#) maxInt  = I# 0x7FFFFFFFFFFFFFFF# #endif--instance Eq Int where-    (==) = eqInt-    (/=) = neInt--instance Ord Int where-    compare = compareInt-    (<)     = ltInt-    (<=)    = leInt-    (>=)    = geInt-    (>)     = gtInt--compareInt :: Int -> Int -> Ordering-(I# x#) `compareInt` (I# y#) = compareInt# x# y#--compareInt# :: Int# -> Int# -> Ordering-compareInt# x# y#-    | x# <#  y# = LT-    | x# ==# y# = EQ-    | otherwise = GT \end{code}  @@ -631,7 +609,7 @@     m >> k    = m >>= \ _ -> k     return    = returnIO     (>>=)     = bindIO-    fail s    = GHC.IO.failIO s+    fail s    = failIO s  returnIO :: a -> IO a returnIO x = IO $ \ s -> (# s, x #)@@ -701,12 +679,6 @@ used in the case of partial applications, etc.  \begin{code}-{-# INLINE eqInt #-}-{-# INLINE neInt #-}-{-# INLINE gtInt #-}-{-# INLINE geInt #-}-{-# INLINE ltInt #-}-{-# INLINE leInt #-} {-# INLINE plusInt #-} {-# INLINE minusInt #-} {-# INLINE timesInt #-}@@ -737,14 +709,6 @@ negateInt :: Int -> Int negateInt (I# x) = I# (negateInt# x) -gtInt, geInt, eqInt, neInt, ltInt, leInt :: Int -> Int -> Bool-(I# x) `gtInt` (I# y) = x >#  y-(I# x) `geInt` (I# y) = x >=# y-(I# x) `eqInt` (I# y) = x ==# y-(I# x) `neInt` (I# y) = x /=# y-(I# x) `ltInt` (I# y) = x <#  y-(I# x) `leInt` (I# y) = x <=# y- {-# RULES "x# ># x#"  forall x#. x# >#  x# = False "x# >=# x#" forall x#. x# >=# x# = True@@ -758,9 +722,6 @@ "plusFloat x 0.0"   forall x#. plusFloat#  x#   0.0# = x# "plusFloat 0.0 x"   forall x#. plusFloat#  0.0# x#   = x# "minusFloat x 0.0"  forall x#. minusFloat# x#   0.0# = x#-"minusFloat x x"    forall x#. minusFloat# x#   x#   = 0.0#-"timesFloat x 0.0"  forall x#. timesFloat# x#   0.0# = 0.0#-"timesFloat0.0 x"   forall x#. timesFloat# 0.0# x#   = 0.0# "timesFloat x 1.0"  forall x#. timesFloat# x#   1.0# = x# "timesFloat 1.0 x"  forall x#. timesFloat# 1.0# x#   = x# "divideFloat x 1.0" forall x#. divideFloat# x#  1.0# = x#@@ -788,6 +749,12 @@     "timesDouble x 0.0"  forall x#. (*##) x#    0.0## = 0.0##  These are tested by num014.++Similarly for Float (#5178):++"minusFloat x x"    forall x#. minusFloat# x#   x#   = 0.0#+"timesFloat0.0 x"   forall x#. timesFloat# 0.0# x#   = 0.0#+"timesFloat x 0.0"  forall x#. timesFloat# x#   0.0# = 0.0# -}  -- Wrappers for the shift operations.  The uncheckedShift# family are@@ -839,106 +806,9 @@ "int2Word2Int"  forall x#. int2Word# (word2Int# x#) = x# "word2Int2Word" forall x#. word2Int# (int2Word# x#) = x#   #-}-\end{code}  -%********************************************************-%*                                                      *-\subsection{Unpacking C strings}-%*                                                      *-%********************************************************--This code is needed for virtually all programs, since it's used for-unpacking the strings of error messages.--\begin{code}-unpackCString# :: Addr# -> [Char]-{-# 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-    unpack nh-      | ch `eqChar#` '\0'# = []-      | otherwise          = C# ch : unpack (nh +# 1#)-      where-        !ch = indexCharOffAddr# addr nh--unpackAppendCString# :: Addr# -> [Char] -> [Char]-{-# NOINLINE unpackAppendCString# #-}-     -- See the NOINLINE note on unpackCString# -unpackAppendCString# addr rest-  = unpack 0#-  where-    unpack nh-      | ch `eqChar#` '\0'# = rest-      | otherwise          = C# ch : unpack (nh +# 1#)-      where-        !ch = indexCharOffAddr# addr nh--unpackFoldrCString# :: Addr# -> (Char  -> a -> a) -> a -> a ---- Usually the unpack-list rule turns unpackFoldrCString# into unpackCString#---- It also has a BuiltInRule in PrelRules.lhs:---      unpackFoldrCString# "foo" c (unpackFoldrCString# "baz" c n)---        =  unpackFoldrCString# "foobaz" c n--{-# NOINLINE unpackFoldrCString# #-}--- At one stage I had NOINLINE [0] on the grounds that, unlike--- unpackCString#, there *is* some point in inlining--- unpackFoldrCString#, because we get better code for the--- higher-order function call.  BUT there may be a lot of--- literal strings, and making a separate 'unpack' loop for--- each is highly gratuitous.  See nofib/real/anna/PrettyPrint.--unpackFoldrCString# addr f z -  = unpack 0#-  where-    unpack nh-      | ch `eqChar#` '\0'# = z-      | otherwise          = C# ch `f` unpack (nh +# 1#)-      where-        !ch = indexCharOffAddr# addr nh--unpackCStringUtf8# :: Addr# -> [Char]-unpackCStringUtf8# addr -  = unpack 0#-  where-    unpack nh-      | ch `eqChar#` '\0'#   = []-      | ch `leChar#` '\x7F'# = C# ch : unpack (nh +# 1#)-      | ch `leChar#` '\xDF'# =-          C# (chr# (((ord# ch                                  -# 0xC0#) `uncheckedIShiftL#`  6#) +#-                     (ord# (indexCharOffAddr# addr (nh +# 1#)) -# 0x80#))) :-          unpack (nh +# 2#)-      | ch `leChar#` '\xEF'# =-          C# (chr# (((ord# ch                                  -# 0xE0#) `uncheckedIShiftL#` 12#) +#-                    ((ord# (indexCharOffAddr# addr (nh +# 1#)) -# 0x80#) `uncheckedIShiftL#`  6#) +#-                     (ord# (indexCharOffAddr# addr (nh +# 2#)) -# 0x80#))) :-          unpack (nh +# 3#)-      | otherwise            =-          C# (chr# (((ord# ch                                  -# 0xF0#) `uncheckedIShiftL#` 18#) +#-                    ((ord# (indexCharOffAddr# addr (nh +# 1#)) -# 0x80#) `uncheckedIShiftL#` 12#) +#-                    ((ord# (indexCharOffAddr# addr (nh +# 2#)) -# 0x80#) `uncheckedIShiftL#`  6#) +#-                     (ord# (indexCharOffAddr# addr (nh +# 3#)) -# 0x80#))) :-          unpack (nh +# 4#)-      where-        !ch = indexCharOffAddr# addr nh--unpackNBytes# :: Addr# -> Int# -> [Char]-unpackNBytes# _addr 0#   = []-unpackNBytes#  addr len# = unpack [] (len# -# 1#)-    where-     unpack acc i#-      | i# <# 0#  = acc-      | otherwise = -         case indexCharOffAddr# addr i# of-            ch -> unpack (C# ch : acc) (i# -# 1#)-+-- Rules for C strings (the functions themselves are now in GHC.CString) {-# RULES "unpack"       [~1] forall a   . unpackCString# a             = build (unpackFoldrCString# a) "unpack-list"  [1]  forall a   . unpackFoldrCString# a (:) [] = unpackCString# a@@ -950,6 +820,7 @@   #-} \end{code} + #ifdef __HADDOCK__ \begin{code} -- | A special argument for the 'Control.Monad.ST.ST' type constructor,@@ -958,3 +829,4 @@ data RealWorld \end{code} #endif+
GHC/Classes.hs view
@@ -1,5 +1,5 @@--{-# OPTIONS_GHC -XNoImplicitPrelude #-}+{-# LANGUAGE Trustworthy #-}+{-# LANGUAGE NoImplicitPrelude, MagicHash, StandaloneDeriving #-} {-# OPTIONS_GHC -fno-warn-unused-imports #-} -- XXX -fno-warn-unused-imports needed for the GHC.Tuple import below. Sigh. {-# OPTIONS_HADDOCK hide #-}@@ -19,7 +19,6 @@  module GHC.Classes where -import GHC.Bool import GHC.Integer -- GHC.Magic is used in some derived instances import GHC.Magic ()@@ -28,7 +27,10 @@ import GHC.Tuple import GHC.Types import GHC.Unit+-- For defining instances for the generic deriving mechanism+import GHC.Generics (Arity(..), Associativity(..), Fixity(..)) + infix  4  ==, /=, <, <=, >=, > infixr 3  && infixr 2  ||@@ -107,6 +109,16 @@ instance Eq Double where     (D# x) == (D# y) = x ==## y +instance Eq Int where+    (==) = eqInt+    (/=) = neInt++{-# INLINE eqInt #-}+{-# INLINE neInt #-}+eqInt, neInt :: Int -> Int -> Bool+(I# x) `eqInt` (I# y) = x ==# y+(I# x) `neInt` (I# y) = x /=# y+ -- | The 'Ord' class is used for totally ordered datatypes. -- -- Instances of 'Ord' can be derived for any user-defined@@ -224,6 +236,32 @@     (D# x) >= (D# y) = x >=## y     (D# x) >  (D# y) = x >##  y +instance Ord Int where+    compare = compareInt+    (<)     = ltInt+    (<=)    = leInt+    (>=)    = geInt+    (>)     = gtInt++{-# INLINE gtInt #-}+{-# INLINE geInt #-}+{-# INLINE ltInt #-}+{-# INLINE leInt #-}+gtInt, geInt, ltInt, leInt :: Int -> Int -> Bool+(I# x) `gtInt` (I# y) = x >#  y+(I# x) `geInt` (I# y) = x >=# y+(I# x) `ltInt` (I# y) = x <#  y+(I# x) `leInt` (I# y) = x <=# y++compareInt :: Int -> Int -> Ordering+(I# x#) `compareInt` (I# y#) = compareInt# x# y#++compareInt# :: Int# -> Int# -> Ordering+compareInt# x# y#+    | x# <#  y# = LT+    | x# ==# y# = EQ+    | True      = GT+ -- OK, so they're technically not part of a class...:  -- Boolean functions@@ -243,3 +281,17 @@ not True                =  False not False               =  True ++------------------------------------------------------------------------+-- Generic deriving+------------------------------------------------------------------------++-- We need instances for some basic datatypes, but some of those use Int,+-- so we have to put the instances here+deriving instance Eq Arity+deriving instance Eq Associativity+deriving instance Eq Fixity++deriving instance Ord Arity+deriving instance Ord Associativity+deriving instance Ord Fixity
GHC/Conc.lhs view
@@ -1,7 +1,8 @@ \begin{code}-{-# OPTIONS_GHC -XNoImplicitPrelude #-}+{-# LANGUAGE CPP, NoImplicitPrelude #-} {-# OPTIONS_GHC -fno-warn-missing-signatures #-} {-# OPTIONS_HADDOCK not-home #-}+ ----------------------------------------------------------------------------- -- | -- Module      :  GHC.Conc@@ -30,9 +31,13 @@         -- * Forking and suchlike         , forkIO        -- :: IO a -> IO ThreadId         , forkIOUnmasked+        , forkIOWithUnmask+        , forkOn         , forkOnIO      -- :: Int -> IO a -> IO ThreadId         , forkOnIOUnmasked+        , forkOnWithUnmask         , numCapabilities -- :: Int+        , getNumCapabilities -- :: IO Int         , numSparks       -- :: IO Int         , childHandler  -- :: Exception -> IO ()         , myThreadId    -- :: IO ThreadId@@ -46,6 +51,7 @@          , ThreadStatus(..), BlockReason(..)         , threadStatus  -- :: ThreadId -> IO ThreadStatus+        , threadCapability          -- * Waiting         , threadDelay           -- :: Int -> IO ()
GHC/Conc/IO.hs view
@@ -1,6 +1,12 @@-{-# OPTIONS_GHC -XNoImplicitPrelude #-}+{-# LANGUAGE CPP+           , NoImplicitPrelude+           , MagicHash+           , UnboxedTuples+           , ForeignFunctionInterface+  #-} {-# OPTIONS_GHC -fno-warn-missing-signatures #-} {-# OPTIONS_HADDOCK not-home #-}+ ----------------------------------------------------------------------------- -- | -- Module      :  GHC.Conc.IO@@ -59,7 +65,7 @@                          asyncWriteBA, ConsoleEvent(..), win32ConsoleHandler,                          toWin32ConsoleEvent) #else-import qualified System.Event.Thread as Event+import qualified GHC.Event.Thread as Event #endif  ensureIOManagerIsRunning :: IO ()
GHC/Conc/Signal.hs view
@@ -1,4 +1,5 @@-{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE Trustworthy #-}+{-# LANGUAGE NoImplicitPrelude, ForeignFunctionInterface #-}  module GHC.Conc.Signal         ( Signal@@ -19,8 +20,8 @@ import GHC.Base import GHC.Conc.Sync (forkIO) import GHC.IO (mask_, unsafePerformIO)-import GHC.IOArray (IOArray, boundsIOArray, newIOArray, unsafeReadIOArray,-                    unsafeWriteIOArray)+import GHC.IOArray (IOArray, boundsIOArray, newIOArray,+                    unsafeReadIOArray, unsafeWriteIOArray) import GHC.Real (fromIntegral) import GHC.Word (Word8)
GHC/Conc/Sync.lhs view
@@ -1,7 +1,18 @@ \begin{code}-{-# OPTIONS_GHC -XNoImplicitPrelude #-}+{-# LANGUAGE CPP+           , NoImplicitPrelude+           , BangPatterns+           , MagicHash+           , UnboxedTuples+           , UnliftedFFITypes+           , ForeignFunctionInterface+           , DeriveDataTypeable+           , StandaloneDeriving+           , RankNTypes+  #-} {-# OPTIONS_GHC -fno-warn-missing-signatures #-} {-# OPTIONS_HADDOCK not-home #-}+ ----------------------------------------------------------------------------- -- | -- Module      :  GHC.Conc.Sync@@ -30,9 +41,13 @@         -- * Forking and suchlike         , forkIO        -- :: IO a -> IO ThreadId         , forkIOUnmasked-        , forkOnIO      -- :: Int -> IO a -> IO ThreadId+        , forkIOWithUnmask+        , forkOn      -- :: Int -> IO a -> IO ThreadId+        , forkOnIO    -- DEPRECATED         , forkOnIOUnmasked+        , forkOnWithUnmask         , numCapabilities -- :: Int+        , getNumCapabilities -- :: IO Int         , numSparks      -- :: IO Int         , childHandler  -- :: Exception -> IO ()         , myThreadId    -- :: IO ThreadId@@ -46,6 +61,7 @@          , ThreadStatus(..), BlockReason(..)         , threadStatus  -- :: ThreadId -> IO ThreadStatus+        , threadCapability          -- * TVars         , STM(..)@@ -184,44 +200,105 @@  where   action_plus = catchException action childHandler --- | Like 'forkIO', but the child thread is created with asynchronous exceptions--- unmasked (see 'Control.Exception.mask').+{-# DEPRECATED forkIOUnmasked "use forkIOWithUnmask instead" #-}+-- | This function is deprecated; use 'forkIOWIthUnmask' instead forkIOUnmasked :: IO () -> IO ThreadId forkIOUnmasked io = forkIO (unsafeUnmask io) +-- | Like 'forkIO', but the child thread is passed a function that can+-- be used to unmask asynchronous exceptions.  This function is+-- typically used in the following way+--+-- >  ... mask_ $ forkIOWithUnmask $ \unmask ->+-- >                 catch (unmask ...) handler+--+-- so that the exception handler in the child thread is established+-- with asynchronous exceptions masked, meanwhile the main body of+-- the child thread is executed in the unmasked state.+--+-- Note that the unmask function passed to the child thread should+-- only be used in that thread; the behaviour is undefined if it is+-- invoked in a different thread.+--+forkIOWithUnmask :: ((forall a . IO a -> IO a) -> IO ()) -> IO ThreadId+forkIOWithUnmask io = forkIO (io unsafeUnmask)+ {- |-Like 'forkIO', but lets you specify on which CPU the thread is-created.  Unlike a `forkIO` thread, a thread created by `forkOnIO`-will stay on the same CPU for its entire lifetime (`forkIO` threads-can migrate between CPUs according to the scheduling policy).-`forkOnIO` is useful for overriding the scheduling policy when you-know in advance how best to distribute the threads.+Like 'forkIO', but lets you specify on which processor the thread+should run.  Unlike a `forkIO` thread, a thread created by `forkOn`+will stay on the same processor for its entire lifetime (`forkIO`+threads can migrate between processors according to the scheduling+policy).  `forkOn` is useful for overriding the scheduling policy when+you know in advance how best to distribute the threads. -The `Int` argument specifies the CPU number; it is interpreted modulo-'numCapabilities' (note that it actually specifies a capability number-rather than a CPU number, but to a first approximation the two are-equivalent).+The `Int` argument specifies a /capability number/ (see+'getNumCapabilities').  Typically capabilities correspond to physical+processors, but the exact behaviour is implementation-dependent.  The+value passed to 'forkOn' is interpreted modulo the total number of+capabilities as returned by 'getNumCapabilities'.++GHC note: the number of capabilities is specified by the @+RTS -N@+option when the program is started.  Capabilities can be fixed to+actual processor cores with @+RTS -qa@ if the underlying operating+system supports that, although in practice this is usually unnecessary+(and may actually degrade perforamnce in some cases - experimentation+is recommended). -}-forkOnIO :: Int -> IO () -> IO ThreadId-forkOnIO (I# cpu) action = IO $ \ s ->+forkOn :: Int -> IO () -> IO ThreadId+forkOn (I# cpu) action = IO $ \ s ->    case (forkOn# cpu action_plus s) of (# s1, tid #) -> (# s1, ThreadId tid #)  where   action_plus = catchException action childHandler --- | Like 'forkOnIO', but the child thread is created with--- asynchronous exceptions unmasked (see 'Control.Exception.mask').+{-# DEPRECATED forkOnIO "renamed to forkOn" #-}+-- | This function is deprecated; use 'forkOn' instead+forkOnIO :: Int -> IO () -> IO ThreadId+forkOnIO = forkOn++{-# DEPRECATED forkOnIOUnmasked "use forkOnWithUnmask instead" #-}+-- | This function is deprecated; use 'forkOnWIthUnmask' instead forkOnIOUnmasked :: Int -> IO () -> IO ThreadId-forkOnIOUnmasked cpu io = forkOnIO cpu (unsafeUnmask io)+forkOnIOUnmasked cpu io = forkOn cpu (unsafeUnmask io) +-- | Like 'forkIOWithUnmask', but the child thread is pinned to the+-- given CPU, as with 'forkOn'.+forkOnWithUnmask :: Int -> ((forall a . IO a -> IO a) -> IO ()) -> IO ThreadId+forkOnWithUnmask cpu io = forkOn cpu (io unsafeUnmask)+ -- | the value passed to the @+RTS -N@ flag.  This is the number of -- Haskell threads that can run truly simultaneously at any given--- time, and is typically set to the number of physical CPU cores on+-- time, and is typically set to the number of physical processor cores on -- the machine.+-- +-- Strictly speaking it is better to use 'getNumCapabilities', because+-- the number of capabilities might vary at runtime.+-- numCapabilities :: Int-numCapabilities = unsafePerformIO $  do-                    n <- peek n_capabilities-                    return (fromIntegral n)+numCapabilities = unsafePerformIO $ getNumCapabilities +{- |+Returns the number of Haskell threads that can run truly+simultaneously (on separate physical processors) at any given time.+The number passed to `forkOn` is interpreted modulo this+value.++An implementation in which Haskell threads are mapped directly to+OS threads might return the number of physical processor cores in+the machine, and 'forkOn' would be implemented using the OS's+affinity facilities.  An implementation that schedules Haskell+threads onto a smaller number of OS threads (like GHC) would return+the number of such OS threads that can be running simultaneously.++GHC notes: this returns the number passed as the argument to the+@+RTS -N@ flag.  In current implementations, the value is fixed+when the program starts and never changes, but it is possible that+in the future the number of capabilities might vary at runtime.+-}+getNumCapabilities :: IO Int+getNumCapabilities = do+   n <- peek n_capabilities+   return (fromIntegral n)+ -- | Returns the number of sparks currently in the local spark pool numSparks :: IO Int numSparks = IO $ \s -> case numSparks# s of (# s', n #) -> (# s', I# n #)@@ -274,7 +351,10 @@ If the target thread is currently making a foreign call, then the exception will not be raised (and hence 'throwTo' will not return) until the call has completed.  This is the case regardless of whether-the call is inside a 'mask' or not.+the call is inside a 'mask' or not.  However, in GHC a foreign call+can be annotated as @interruptible@, in which case a 'throwTo' will+cause the RTS to attempt to cause the call to return; see the GHC+documentation for more details.  Important note: the behaviour of 'throwTo' differs from that described in the paper \"Asynchronous exceptions in Haskell\"@@ -293,9 +373,17 @@ allocation occurs.  Some loops do not perform any memory allocation inside the loop and therefore cannot be interrupted by a 'throwTo'. -Blocked 'throwTo' is fair: if multiple threads are trying to throw an-exception to the same target thread, they will succeed in FIFO order.+If the target of 'throwTo' is the calling thread, then the behaviour+is the same as 'Control.Exception.throwIO', except that the exception+is thrown as an asynchronous exception.  This means that if there is+an enclosing pure computation, which would be the case if the current+IO operation is inside 'unsafePerformIO' or 'unsafeInterleaveIO', that+computation is not permanently replaced by the exception, but is+suspended as if it had received an asynchronous exception. +Note that if 'throwTo' is called with the current thread as the+target, the exception will be thrown even if the thread is currently+inside 'mask' or 'uninterruptibleMask'.   -} throwTo :: Exception e => ThreadId -> e -> IO () throwTo (ThreadId tid) ex = IO $ \ s ->@@ -390,19 +478,28 @@ threadStatus :: ThreadId -> IO ThreadStatus threadStatus (ThreadId t) = IO $ \s ->    case threadStatus# t s of-     (# s', stat #) -> (# s', mk_stat (I# stat) #)+    (# s', stat, _cap, _locked #) -> (# s', mk_stat (I# stat) #)    where         -- NB. keep these in sync with includes/Constants.h      mk_stat 0  = ThreadRunning      mk_stat 1  = ThreadBlocked BlockedOnMVar      mk_stat 2  = ThreadBlocked BlockedOnBlackHole-     mk_stat 3  = ThreadBlocked BlockedOnException-     mk_stat 7  = ThreadBlocked BlockedOnSTM+     mk_stat 6  = ThreadBlocked BlockedOnSTM+     mk_stat 10 = ThreadBlocked BlockedOnForeignCall      mk_stat 11 = ThreadBlocked BlockedOnForeignCall-     mk_stat 12 = ThreadBlocked BlockedOnForeignCall+     mk_stat 12 = ThreadBlocked BlockedOnException      mk_stat 16 = ThreadFinished      mk_stat 17 = ThreadDied      mk_stat _  = ThreadBlocked BlockedOnOther++-- | returns the number of the capability on which the thread is currently+-- running, and a boolean indicating whether the thread is locked to+-- that capability or not.  A thread is locked to a capability if it+-- was created with @forkOn@.+threadCapability :: ThreadId -> IO (Int, Bool)+threadCapability (ThreadId t) = IO $ \s ->+   case threadStatus# t s of+     (# s', _, cap#, locked# #) -> (# s', (I# cap#, locked# /=# 0#) #) \end{code}
GHC/Conc/Windows.hs view
@@ -1,6 +1,8 @@-{-# OPTIONS_GHC -XNoImplicitPrelude #-}+{-# LANGUAGE NoImplicitPrelude, MagicHash, UnboxedTuples, ForeignFunctionInterface,+             DeriveDataTypeable #-} {-# OPTIONS_GHC -fno-warn-missing-signatures #-} {-# OPTIONS_HADDOCK not-home #-}+ ----------------------------------------------------------------------------- -- | -- Module      :  GHC.Conc.Windows@@ -40,7 +42,6 @@ import Data.Bits (shiftR) import Data.Maybe (Maybe(..)) import Data.Typeable-import Foreign.C.Error (throwErrno) import GHC.Base import GHC.Conc.Sync import GHC.Enum (Enum)@@ -53,6 +54,7 @@ import GHC.Real (div, fromIntegral) import GHC.Show (Show) import GHC.Word (Word32, Word64)+import GHC.Windows  -- ---------------------------------------------------------------------------- -- Thread waiting@@ -104,7 +106,7 @@ threadDelay time   | threaded  = waitForDelayEvent time   | otherwise = IO $ \s ->-        case fromIntegral time of { I# time# ->+        case time of { I# time# ->         case delay# time# s of { s' -> (# s', () #)         }} @@ -234,7 +236,7 @@    r <- c_WaitForSingleObject wakeup timeout   case r of-    0xffffffff -> do c_maperrno; throwErrno "service_loop"+    0xffffffff -> do throwGetLastError "service_loop"     0 -> do         r2 <- c_readIOManagerEvent         exit <-@@ -310,15 +312,6 @@             milli_seconds = (micro_seconds + 999) `div` 1000         in return (all, fromIntegral milli_seconds) --- ToDo: this just duplicates part of System.Win32.Types, which isn't--- available yet.  We should move some Win32 functionality down here,--- maybe as part of the grand reorganisation of the base package...-type HANDLE       = Ptr ()-type DWORD        = Word32--iNFINITE :: DWORD-iNFINITE = 0xFFFFFFFF -- urgh- foreign import ccall unsafe "getIOManagerEvent" -- in the RTS (ThrIOManager.c)   c_getIOManagerEvent :: IO HANDLE @@ -327,9 +320,6 @@  foreign import ccall unsafe "sendIOManagerEvent" -- in the RTS (ThrIOManager.c)   c_sendIOManagerEvent :: Word32 -> IO ()--foreign import ccall unsafe "maperrno"             -- in Win32Utils.c-   c_maperrno :: IO ()  foreign import stdcall "WaitForSingleObject"    c_WaitForSingleObject :: HANDLE -> DWORD -> IO DWORD
GHC/ConsoleHandler.hs view
@@ -1,4 +1,6 @@-{-# OPTIONS_GHC -cpp #-}+{-# LANGUAGE Trustworthy #-}+{-# LANGUAGE CPP, ForeignFunctionInterface #-}+ ----------------------------------------------------------------------------- -- | -- Module      :  GHC.ConsoleHandler@@ -42,8 +44,6 @@ #ifdef mingw32_HOST_OS import Data.Maybe import GHC.Base-import GHC.Num-import GHC.Real #endif  data Handler@@ -148,7 +148,7 @@                         "handle is not a file descriptor" Nothing Nothing       Just fd -> do         throwErrnoIfMinus1Retry_ "flushConsole" $-           flush_console_fd (fromIntegral (fdFD fd))+           flush_console_fd (fdFD fd)  foreign import ccall unsafe "consUtils.h flush_input_console__"         flush_console_fd :: CInt -> IO CInt
GHC/Constants.hs view
@@ -1,3 +1,5 @@+{-# LANGUAGE Trustworthy #-}+{-# LANGUAGE CPP #-}  module GHC.Constants where
GHC/Desugar.hs view
@@ -1,3 +1,10 @@+{-# LANGUAGE Trustworthy #-}+{-# LANGUAGE CPP+           , NoImplicitPrelude+           , Rank2Types+           , ExistentialQuantification+  #-}+ ----------------------------------------------------------------------------- -- | -- Module      :  GHC.Desugar
GHC/Enum.lhs view
@@ -1,5 +1,6 @@ \begin{code}-{-# OPTIONS_GHC -XNoImplicitPrelude #-}+{-# LANGUAGE Trustworthy #-}+{-# LANGUAGE NoImplicitPrelude, BangPatterns, MagicHash #-} {-# OPTIONS_HADDOCK hide #-} ----------------------------------------------------------------------------- -- |
GHC/Environment.hs view
@@ -1,11 +1,43 @@+{-# LANGUAGE Trustworthy #-}+{-# LANGUAGE CPP, ForeignFunctionInterface #-}  module GHC.Environment (getFullArgs) where  import Prelude import Foreign import Foreign.C++#ifdef mingw32_HOST_OS+import GHC.IO (finally)+import GHC.Windows++-- Ignore the arguments to hs_init on Windows for the sake of Unicode compat+getFullArgs :: IO [String]+getFullArgs = do+    p_arg_string <- c_GetCommandLine+    alloca $ \p_argc -> do+     p_argv <- c_CommandLineToArgv p_arg_string p_argc+     if p_argv == nullPtr+      then throwGetLastError "getFullArgs"+      else flip finally (c_LocalFree p_argv) $ do+       argc <- peek p_argc+       p_argvs <- peekArray (fromIntegral argc) p_argv+       mapM peekCWString p_argvs++foreign import stdcall unsafe "windows.h GetCommandLineW"+    c_GetCommandLine :: IO (Ptr CWString)++foreign import stdcall unsafe "windows.h CommandLineToArgvW"+    c_CommandLineToArgv :: Ptr CWString -> Ptr CInt -> IO (Ptr CWString)++foreign import stdcall unsafe "Windows.h LocalFree"+    c_LocalFree :: Ptr a -> IO (Ptr a)+#else import Control.Monad +import GHC.IO.Encoding+import qualified GHC.Foreign as GHC+ getFullArgs :: IO [String] getFullArgs =   alloca $ \ p_argc ->@@ -13,8 +45,8 @@    getFullProgArgv p_argc p_argv    p    <- fromIntegral `liftM` peek p_argc    argv <- peek p_argv-   peekArray (p - 1) (advancePtr argv 1) >>= mapM peekCString+   peekArray (p - 1) (advancePtr argv 1) >>= mapM (GHC.peekCString fileSystemEncoding)  foreign import ccall unsafe "getFullProgArgv"     getFullProgArgv :: Ptr CInt -> Ptr (Ptr CString) -> IO ()-+#endif
GHC/Err.lhs view
@@ -1,6 +1,8 @@ \begin{code}-{-# OPTIONS_GHC -XNoImplicitPrelude #-}+{-# LANGUAGE Trustworthy #-}+{-# LANGUAGE CPP, NoImplicitPrelude #-} {-# OPTIONS_HADDOCK hide #-}+ ----------------------------------------------------------------------------- -- | -- Module      :  GHC.Err
GHC/Err.lhs-boot view
@@ -1,5 +1,7 @@ \begin{code}-{-# OPTIONS_GHC -XNoImplicitPrelude #-}+{-# LANGUAGE Trustworthy #-}+{-# LANGUAGE NoImplicitPrelude #-}+ --------------------------------------------------------------------------- --                  Ghc.Err.hs-boot ---------------------------------------------------------------------------
+ GHC/Event.hs view
@@ -0,0 +1,42 @@+{-# LANGUAGE Trustworthy #-}+-- | This module provides scalable event notification for file+-- descriptors and timeouts.+--+-- This module should be considered GHC internal.+module GHC.Event+    ( -- * Types+      EventManager++      -- * Creation+    , new+    , getSystemEventManager++      -- * Running+    , loop++    -- ** Stepwise running+    , step+    , shutdown++      -- * Registering interest in I/O events+    , Event+    , evtRead+    , evtWrite+    , IOCallback+    , FdKey(keyFd)+    , registerFd+    , registerFd_+    , unregisterFd+    , unregisterFd_+    , closeFd++      -- * Registering interest in timeout events+    , TimeoutCallback+    , TimeoutKey+    , registerTimeout+    , updateTimeout+    , unregisterTimeout+    ) where++import GHC.Event.Manager+import GHC.Event.Thread (getSystemEventManager)
+ GHC/Event/Array.hs view
@@ -0,0 +1,313 @@+{-# LANGUAGE BangPatterns, CPP, ForeignFunctionInterface, NoImplicitPrelude #-}++module GHC.Event.Array+    (+      Array+    , capacity+    , clear+    , concat+    , copy+    , duplicate+    , empty+    , ensureCapacity+    , findIndex+    , forM_+    , length+    , loop+    , new+    , removeAt+    , snoc+    , unsafeLoad+    , unsafeRead+    , unsafeWrite+    , useAsPtr+    ) where++import Control.Monad hiding (forM_)+import Data.Bits ((.|.), shiftR)+import Data.IORef (IORef, atomicModifyIORef, newIORef, readIORef, writeIORef)+import Data.Maybe+import Foreign.C.Types (CSize)+import Foreign.ForeignPtr (ForeignPtr, withForeignPtr)+import Foreign.Ptr (Ptr, nullPtr, plusPtr)+import Foreign.Storable (Storable(..))+import GHC.Base+import GHC.Err (undefined)+import GHC.ForeignPtr (mallocPlainForeignPtrBytes, newForeignPtr_)+import GHC.Num (Num(..))+import GHC.Real (fromIntegral)+import GHC.Show (show)++#include "MachDeps.h"++#define BOUNDS_CHECKING 1++#if defined(BOUNDS_CHECKING)+-- This fugly hack is brought by GHC's apparent reluctance to deal+-- with MagicHash and UnboxedTuples when inferring types. Eek!+#define CHECK_BOUNDS(_func_,_len_,_k_) \+if (_k_) < 0 || (_k_) >= (_len_) then error ("GHC.Event.Array." ++ (_func_) ++ ": bounds error, index " ++ show (_k_) ++ ", capacity " ++ show (_len_)) else+#else+#define CHECK_BOUNDS(_func_,_len_,_k_)+#endif++-- Invariant: size <= capacity+newtype Array a = Array (IORef (AC a))++-- The actual array content.+data AC a = AC+    !(ForeignPtr a)  -- Elements+    !Int      -- Number of elements (length)+    !Int      -- Maximum number of elements (capacity)++empty :: IO (Array a)+empty = do+  p <- newForeignPtr_ nullPtr+  Array `fmap` newIORef (AC p 0 0)++allocArray :: Storable a => Int -> IO (ForeignPtr a)+allocArray n = allocHack undefined+ where+  allocHack :: Storable a => a -> IO (ForeignPtr a)+  allocHack dummy = mallocPlainForeignPtrBytes (n * sizeOf dummy)++reallocArray :: Storable a => ForeignPtr a -> Int -> Int -> IO (ForeignPtr a)+reallocArray p newSize oldSize = reallocHack undefined p+ where+  reallocHack :: Storable a => a -> ForeignPtr a -> IO (ForeignPtr a)+  reallocHack dummy src = do+      let size = sizeOf dummy+      dst <- mallocPlainForeignPtrBytes (newSize * size)+      withForeignPtr src $ \s ->+        when (s /= nullPtr && oldSize > 0) .+          withForeignPtr dst $ \d -> do+            _ <- memcpy d s (fromIntegral (oldSize * size))+            return ()+      return dst++new :: Storable a => Int -> IO (Array a)+new c = do+    es <- allocArray cap+    fmap Array (newIORef (AC es 0 cap))+  where+    cap = firstPowerOf2 c++duplicate :: Storable a => Array a -> IO (Array a)+duplicate a = dupHack undefined a+ where+  dupHack :: Storable b => b -> Array b -> IO (Array b)+  dupHack dummy (Array ref) = do+    AC es len cap <- readIORef ref+    ary <- allocArray cap+    withForeignPtr ary $ \dest ->+      withForeignPtr es $ \src -> do+        _ <- memcpy dest src (fromIntegral (len * sizeOf dummy))+        return ()+    Array `fmap` newIORef (AC ary len cap)++length :: Array a -> IO Int+length (Array ref) = do+    AC _ len _ <- readIORef ref+    return len++capacity :: Array a -> IO Int+capacity (Array ref) = do+    AC _ _ cap <- readIORef ref+    return cap++unsafeRead :: Storable a => Array a -> Int -> IO a+unsafeRead (Array ref) ix = do+    AC es _ cap <- readIORef ref+    CHECK_BOUNDS("unsafeRead",cap,ix)+      withForeignPtr es $ \p ->+        peekElemOff p ix++unsafeWrite :: Storable a => Array a -> Int -> a -> IO ()+unsafeWrite (Array ref) ix a = do+    ac <- readIORef ref+    unsafeWrite' ac ix a++unsafeWrite' :: Storable a => AC a -> Int -> a -> IO ()+unsafeWrite' (AC es _ cap) ix a = do+    CHECK_BOUNDS("unsafeWrite'",cap,ix)+      withForeignPtr es $ \p ->+        pokeElemOff p ix a++unsafeLoad :: Storable a => Array a -> (Ptr a -> Int -> IO Int) -> IO Int+unsafeLoad (Array ref) load = do+    AC es _ cap <- readIORef ref+    len' <- withForeignPtr es $ \p -> load p cap+    writeIORef ref (AC es len' cap)+    return len'++ensureCapacity :: Storable a => Array a -> Int -> IO ()+ensureCapacity (Array ref) c = do+    ac@(AC _ _ cap) <- readIORef ref+    ac'@(AC _ _ cap') <- ensureCapacity' ac c+    when (cap' /= cap) $+      writeIORef ref ac'++ensureCapacity' :: Storable a => AC a -> Int -> IO (AC a)+ensureCapacity' ac@(AC es len cap) c = do+    if c > cap+      then do+        es' <- reallocArray es cap' cap+        return (AC es' len cap')+      else+        return ac+  where+    cap' = firstPowerOf2 c++useAsPtr :: Array a -> (Ptr a -> Int -> IO b) -> IO b+useAsPtr (Array ref) f = do+    AC es len _ <- readIORef ref+    withForeignPtr es $ \p -> f p len++snoc :: Storable a => Array a -> a -> IO ()+snoc (Array ref) e = do+    ac@(AC _ len _) <- readIORef ref+    let len' = len + 1+    ac'@(AC es _ cap) <- ensureCapacity' ac len'+    unsafeWrite' ac' len e+    writeIORef ref (AC es len' cap)++clear :: Storable a => Array a -> IO ()+clear (Array ref) = do+  !_ <- atomicModifyIORef ref $ \(AC es _ cap) ->+        let e = AC es 0 cap in (e, e)+  return ()++forM_ :: Storable a => Array a -> (a -> IO ()) -> IO ()+forM_ ary g = forHack ary g undefined+  where+    forHack :: Storable b => Array b -> (b -> IO ()) -> b -> IO ()+    forHack (Array ref) f dummy = do+      AC es len _ <- readIORef ref+      let size = sizeOf dummy+          offset = len * size+      withForeignPtr es $ \p -> do+        let go n | n >= offset = return ()+                 | otherwise = do+              f =<< peek (p `plusPtr` n)+              go (n + size)+        go 0++loop :: Storable a => Array a -> b -> (b -> a -> IO (b,Bool)) -> IO ()+loop ary z g = loopHack ary z g undefined+  where+    loopHack :: Storable b => Array b -> c -> (c -> b -> IO (c,Bool)) -> b+             -> IO ()+    loopHack (Array ref) y f dummy = do+      AC es len _ <- readIORef ref+      let size = sizeOf dummy+          offset = len * size+      withForeignPtr es $ \p -> do+        let go n k+                | n >= offset = return ()+                | otherwise = do+                      (k',cont) <- f k =<< peek (p `plusPtr` n)+                      when cont $ go (n + size) k'+        go 0 y++findIndex :: Storable a => (a -> Bool) -> Array a -> IO (Maybe (Int,a))+findIndex = findHack undefined+ where+  findHack :: Storable b => b -> (b -> Bool) -> Array b -> IO (Maybe (Int,b))+  findHack dummy p (Array ref) = do+    AC es len _ <- readIORef ref+    let size   = sizeOf dummy+        offset = len * size+    withForeignPtr es $ \ptr ->+      let go !n !i+            | n >= offset = return Nothing+            | otherwise = do+                val <- peek (ptr `plusPtr` n)+                if p val+                  then return $ Just (i, val)+                  else go (n + size) (i + 1)+      in  go 0 0++concat :: Storable a => Array a -> Array a -> IO ()+concat (Array d) (Array s) = do+  da@(AC _ dlen _) <- readIORef d+  sa@(AC _ slen _) <- readIORef s+  writeIORef d =<< copy' da dlen sa 0 slen++-- | Copy part of the source array into the destination array. The+-- destination array is resized if not large enough.+copy :: Storable a => Array a -> Int -> Array a -> Int -> Int -> IO ()+copy (Array d) dstart (Array s) sstart maxCount = do+  da <- readIORef d+  sa <- readIORef s+  writeIORef d =<< copy' da dstart sa sstart maxCount++-- | Copy part of the source array into the destination array. The+-- destination array is resized if not large enough.+copy' :: Storable a => AC a -> Int -> AC a -> Int -> Int -> IO (AC a)+copy' d dstart s sstart maxCount = copyHack d s undefined+ where+  copyHack :: Storable b => AC b -> AC b -> b -> IO (AC b)+  copyHack dac@(AC _ oldLen _) (AC src slen _) dummy = do+    when (maxCount < 0 || dstart < 0 || dstart > oldLen || sstart < 0 ||+          sstart > slen) $ error "copy: bad offsets or lengths"+    let size = sizeOf dummy+        count = min maxCount (slen - sstart)+    if count == 0+      then return dac+      else do+        AC dst dlen dcap <- ensureCapacity' dac (dstart + count)+        withForeignPtr dst $ \dptr ->+          withForeignPtr src $ \sptr -> do+            _ <- memcpy (dptr `plusPtr` (dstart * size))+                        (sptr `plusPtr` (sstart * size))+                        (fromIntegral (count * size))+            return $ AC dst (max dlen (dstart + count)) dcap++removeAt :: Storable a => Array a -> Int -> IO ()+removeAt a i = removeHack a undefined+ where+  removeHack :: Storable b => Array b -> b -> IO ()+  removeHack (Array ary) dummy = do+    AC fp oldLen cap <- readIORef ary+    when (i < 0 || i >= oldLen) $ error "removeAt: invalid index"+    let size   = sizeOf dummy+        newLen = oldLen - 1+    when (newLen > 0 && i < newLen) .+      withForeignPtr fp $ \ptr -> do+        _ <- memmove (ptr `plusPtr` (size * i))+                     (ptr `plusPtr` (size * (i+1)))+                     (fromIntegral (size * (newLen-i)))+        return ()+    writeIORef ary (AC fp newLen cap)++{-The firstPowerOf2 function works by setting all bits on the right-hand+side of the most significant flagged bit to 1, and then incrementing+the entire value at the end so it "rolls over" to the nearest power of+two.+-}++-- | Computes the next-highest power of two for a particular integer,+-- @n@.  If @n@ is already a power of two, returns @n@.  If @n@ is+-- zero, returns zero, even though zero is not a power of two.+firstPowerOf2 :: Int -> Int+firstPowerOf2 !n =+    let !n1 = n - 1+        !n2 = n1 .|. (n1 `shiftR` 1)+        !n3 = n2 .|. (n2 `shiftR` 2)+        !n4 = n3 .|. (n3 `shiftR` 4)+        !n5 = n4 .|. (n4 `shiftR` 8)+        !n6 = n5 .|. (n5 `shiftR` 16)+#if WORD_SIZE_IN_BITS == 32+    in n6 + 1+#elif WORD_SIZE_IN_BITS == 64+        !n7 = n6 .|. (n6 `shiftR` 32)+    in n7 + 1+#else+# error firstPowerOf2 not defined on this architecture+#endif++foreign import ccall unsafe "string.h memcpy"+    memcpy :: Ptr a -> Ptr a -> CSize -> IO (Ptr a)++foreign import ccall unsafe "string.h memmove"+    memmove :: Ptr a -> Ptr a -> CSize -> IO (Ptr a)
+ GHC/Event/Clock.hsc view
@@ -0,0 +1,48 @@+{-# LANGUAGE NoImplicitPrelude, BangPatterns, ForeignFunctionInterface #-}++module GHC.Event.Clock (getCurrentTime) where++#include <sys/time.h>++import Foreign (Ptr, Storable(..), nullPtr, with)+import Foreign.C.Error (throwErrnoIfMinus1_)+import Foreign.C.Types (CInt, CLong, CTime, CSUSeconds)+import GHC.Base+import GHC.Err+import GHC.Num+import GHC.Real++-- TODO: Implement this for Windows.++-- | Return the current time, in seconds since Jan. 1, 1970.+getCurrentTime :: IO Double+getCurrentTime = do+    tv <- with (CTimeval 0 0) $ \tvptr -> do+        throwErrnoIfMinus1_ "gettimeofday" (gettimeofday tvptr nullPtr)+        peek tvptr+    let !t = realToFrac (sec tv) + realToFrac (usec tv) / 1000000.0+    return t++------------------------------------------------------------------------+-- FFI binding++data CTimeval = CTimeval+    { sec  :: {-# UNPACK #-} !CTime+    , usec :: {-# UNPACK #-} !CSUSeconds+    }++instance Storable CTimeval where+    sizeOf _ = #size struct timeval+    alignment _ = alignment (undefined :: CLong)++    peek ptr = do+        sec' <- #{peek struct timeval, tv_sec} ptr+        usec' <- #{peek struct timeval, tv_usec} ptr+        return $ CTimeval sec' usec'++    poke ptr tv = do+        #{poke struct timeval, tv_sec} ptr (sec tv)+        #{poke struct timeval, tv_usec} ptr (usec tv)++foreign import ccall unsafe "sys/time.h gettimeofday" gettimeofday+    :: Ptr CTimeval -> Ptr () -> IO CInt
+ GHC/Event/Control.hs view
@@ -0,0 +1,214 @@+{-# LANGUAGE CPP+           , ForeignFunctionInterface+           , NoImplicitPrelude+           , ScopedTypeVariables+           , BangPatterns+  #-}++module GHC.Event.Control+    (+    -- * Managing the IO manager+      Signal+    , ControlMessage(..)+    , Control+    , newControl+    , closeControl+    -- ** Control message reception+    , readControlMessage+    -- *** File descriptors+    , controlReadFd+    , wakeupReadFd+    -- ** Control message sending+    , sendWakeup+    , sendDie+    -- * Utilities+    , setNonBlockingFD+    ) where++#include "EventConfig.h"++import Control.Monad (when)+import Foreign.ForeignPtr (ForeignPtr)+import GHC.Base+import GHC.Conc.Signal (Signal)+import GHC.Real (fromIntegral)+import GHC.Show (Show)+import GHC.Word (Word8)+import Foreign.C.Error (throwErrnoIfMinus1_)+import Foreign.C.Types (CInt, CSize)+import Foreign.ForeignPtr (mallocForeignPtrBytes, withForeignPtr)+import Foreign.Marshal (alloca, allocaBytes)+import Foreign.Marshal.Array (allocaArray)+import Foreign.Ptr (castPtr)+import Foreign.Storable (peek, peekElemOff, poke)+import System.Posix.Internals (c_close, c_pipe, c_read, c_write,+                               setCloseOnExec, setNonBlockingFD)+import System.Posix.Types (Fd)++#if defined(HAVE_EVENTFD)+import Data.Word (Word64)+import Foreign.C.Error (throwErrnoIfMinus1)+#else+import Foreign.C.Error (eAGAIN, eWOULDBLOCK, getErrno, throwErrno)+#endif++data ControlMessage = CMsgWakeup+                    | CMsgDie+                    | CMsgSignal {-# UNPACK #-} !(ForeignPtr Word8)+                                 {-# UNPACK #-} !Signal+    deriving (Eq, Show)++-- | The structure used to tell the IO manager thread what to do.+data Control = W {+      controlReadFd  :: {-# UNPACK #-} !Fd+    , controlWriteFd :: {-# UNPACK #-} !Fd+#if defined(HAVE_EVENTFD)+    , controlEventFd :: {-# UNPACK #-} !Fd+#else+    , wakeupReadFd   :: {-# UNPACK #-} !Fd+    , wakeupWriteFd  :: {-# UNPACK #-} !Fd+#endif+    } deriving (Show)++#if defined(HAVE_EVENTFD)+wakeupReadFd :: Control -> Fd+wakeupReadFd = controlEventFd+{-# INLINE wakeupReadFd #-}+#endif++setNonBlock :: CInt -> IO ()+setNonBlock fd =+#if __GLASGOW_HASKELL__ >= 611+  setNonBlockingFD fd True+#else+  setNonBlockingFD fd+#endif++-- | Create the structure (usually a pipe) used for waking up the IO+-- manager thread from another thread.+newControl :: IO Control+newControl = allocaArray 2 $ \fds -> do+  let createPipe = do+        throwErrnoIfMinus1_ "pipe" $ c_pipe fds+        rd <- peekElemOff fds 0+        wr <- peekElemOff fds 1+        -- The write end must be non-blocking, since we may need to+        -- poke the event manager from a signal handler.+        setNonBlock wr+        setCloseOnExec rd+        setCloseOnExec wr+        return (rd, wr)+  (ctrl_rd, ctrl_wr) <- createPipe+  c_setIOManagerControlFd ctrl_wr+#if defined(HAVE_EVENTFD)+  ev <- throwErrnoIfMinus1 "eventfd" $ c_eventfd 0 0+  setNonBlock ev+  setCloseOnExec ev+  c_setIOManagerWakeupFd ev+#else+  (wake_rd, wake_wr) <- createPipe+  c_setIOManagerWakeupFd wake_wr+#endif+  return W { controlReadFd  = fromIntegral ctrl_rd+           , controlWriteFd = fromIntegral ctrl_wr+#if defined(HAVE_EVENTFD)+           , controlEventFd = fromIntegral ev+#else+           , wakeupReadFd   = fromIntegral wake_rd+           , wakeupWriteFd  = fromIntegral wake_wr+#endif+           }++-- | Close the control structure used by the IO manager thread.+closeControl :: Control -> IO ()+closeControl w = do+  _ <- c_close . fromIntegral . controlReadFd $ w+  _ <- c_close . fromIntegral . controlWriteFd $ w+#if defined(HAVE_EVENTFD)+  _ <- c_close . fromIntegral . controlEventFd $ w+#else+  _ <- c_close . fromIntegral . wakeupReadFd $ w+  _ <- c_close . fromIntegral . wakeupWriteFd $ w+#endif+  return ()++io_MANAGER_WAKEUP, io_MANAGER_DIE :: Word8+io_MANAGER_WAKEUP = 0xff+io_MANAGER_DIE    = 0xfe++foreign import ccall "__hscore_sizeof_siginfo_t"+    sizeof_siginfo_t :: CSize++readControlMessage :: Control -> Fd -> IO ControlMessage+readControlMessage ctrl fd+    | fd == wakeupReadFd ctrl = allocaBytes wakeupBufferSize $ \p -> do+                    throwErrnoIfMinus1_ "readWakeupMessage" $+                      c_read (fromIntegral fd) p (fromIntegral wakeupBufferSize)+                    return CMsgWakeup+    | otherwise =+        alloca $ \p -> do+            throwErrnoIfMinus1_ "readControlMessage" $+                c_read (fromIntegral fd) p 1+            s <- peek p+            case s of+                -- Wakeup messages shouldn't be sent on the control+                -- file descriptor but we handle them anyway.+                _ | s == io_MANAGER_WAKEUP -> return CMsgWakeup+                _ | s == io_MANAGER_DIE    -> return CMsgDie+                _ -> do  -- Signal+                    fp <- mallocForeignPtrBytes (fromIntegral sizeof_siginfo_t)+                    withForeignPtr fp $ \p_siginfo -> do+                        r <- c_read (fromIntegral fd) (castPtr p_siginfo)+                             sizeof_siginfo_t+                        when (r /= fromIntegral sizeof_siginfo_t) $+                            error "failed to read siginfo_t"+                        let !s' = fromIntegral s+                        return $ CMsgSignal fp s'++  where wakeupBufferSize =+#if defined(HAVE_EVENTFD)+            8+#else+            4096+#endif++sendWakeup :: Control -> IO ()+#if defined(HAVE_EVENTFD)+sendWakeup c = alloca $ \p -> do+  poke p (1 :: Word64)+  throwErrnoIfMinus1_ "sendWakeup" $+    c_write (fromIntegral (controlEventFd c)) (castPtr p) 8+#else+sendWakeup c = do+  n <- sendMessage (wakeupWriteFd c) CMsgWakeup+  case n of+    _ | n /= -1   -> return ()+      | otherwise -> do+                   errno <- getErrno+                   when (errno /= eAGAIN && errno /= eWOULDBLOCK) $+                     throwErrno "sendWakeup"+#endif++sendDie :: Control -> IO ()+sendDie c = throwErrnoIfMinus1_ "sendDie" $+            sendMessage (controlWriteFd c) CMsgDie++sendMessage :: Fd -> ControlMessage -> IO Int+sendMessage fd msg = alloca $ \p -> do+  case msg of+    CMsgWakeup        -> poke p io_MANAGER_WAKEUP+    CMsgDie           -> poke p io_MANAGER_DIE+    CMsgSignal _fp _s -> error "Signals can only be sent from within the RTS"+  fromIntegral `fmap` c_write (fromIntegral fd) p 1++#if defined(HAVE_EVENTFD)+foreign import ccall unsafe "sys/eventfd.h eventfd"+   c_eventfd :: CInt -> CInt -> IO CInt+#endif++-- Used to tell the RTS how it can send messages to the I/O manager.+foreign import ccall "setIOManagerControlFd"+   c_setIOManagerControlFd :: CInt -> IO ()++foreign import ccall "setIOManagerWakeupFd"+   c_setIOManagerWakeupFd :: CInt -> IO ()
+ GHC/Event/EPoll.hsc view
@@ -0,0 +1,206 @@+{-# LANGUAGE CPP+           , ForeignFunctionInterface+           , GeneralizedNewtypeDeriving+           , NoImplicitPrelude+           , BangPatterns+  #-}++--+-- | A binding to the epoll I/O event notification facility+--+-- epoll is a variant of poll that can be used either as an edge-triggered or+-- a level-triggered interface and scales well to large numbers of watched file+-- descriptors.+--+-- epoll decouples monitor an fd from the process of registering it.+--+module GHC.Event.EPoll+    (+      new+    , available+    ) where++import qualified GHC.Event.Internal as E++#include "EventConfig.h"+#if !defined(HAVE_EPOLL)+import GHC.Base++new :: IO E.Backend+new = error "EPoll back end not implemented for this platform"++available :: Bool+available = False+{-# INLINE available #-}+#else++#include <sys/epoll.h>++import Control.Monad (when)+import Data.Bits (Bits, (.|.), (.&.))+import Data.Monoid (Monoid(..))+import Data.Word (Word32)+import Foreign.C.Error (throwErrnoIfMinus1, throwErrnoIfMinus1_)+import Foreign.C.Types (CInt)+import Foreign.Marshal.Utils (with)+import Foreign.Ptr (Ptr)+import Foreign.Storable (Storable(..))+import GHC.Base+import GHC.Err (undefined)+import GHC.Num (Num(..))+import GHC.Real (ceiling, fromIntegral)+import GHC.Show (Show)+import System.Posix.Internals (c_close)+import System.Posix.Internals (setCloseOnExec)+import System.Posix.Types (Fd(..))++import qualified GHC.Event.Array    as A+import           GHC.Event.Internal (Timeout(..))++available :: Bool+available = True+{-# INLINE available #-}++data EPoll = EPoll {+      epollFd     :: {-# UNPACK #-} !EPollFd+    , epollEvents :: {-# UNPACK #-} !(A.Array Event)+    }++-- | Create a new epoll backend.+new :: IO E.Backend+new = do+  epfd <- epollCreate+  evts <- A.new 64+  let !be = E.backend poll modifyFd delete (EPoll epfd evts)+  return be++delete :: EPoll -> IO ()+delete be = do+  _ <- c_close . fromEPollFd . epollFd $ be+  return ()++-- | Change the set of events we are interested in for a given file+-- descriptor.+modifyFd :: EPoll -> Fd -> E.Event -> E.Event -> IO ()+modifyFd ep fd oevt nevt = with (Event (fromEvent nevt) fd) $+                             epollControl (epollFd ep) op fd+  where op | oevt == mempty = controlOpAdd+           | nevt == mempty = controlOpDelete+           | otherwise      = controlOpModify++-- | Select a set of file descriptors which are ready for I/O+-- operations and call @f@ for all ready file descriptors, passing the+-- events that are ready.+poll :: EPoll                     -- ^ state+     -> Timeout                   -- ^ timeout in milliseconds+     -> (Fd -> E.Event -> IO ())  -- ^ I/O callback+     -> IO ()+poll ep timeout f = do+  let events = epollEvents ep++  -- Will return zero if the system call was interupted, in which case+  -- we just return (and try again later.)+  n <- A.unsafeLoad events $ \es cap ->+       epollWait (epollFd ep) es cap $ fromTimeout timeout++  when (n > 0) $ do+    A.forM_ events $ \e -> f (eventFd e) (toEvent (eventTypes e))+    cap <- A.capacity events+    when (cap == n) $ A.ensureCapacity events (2 * cap)++newtype EPollFd = EPollFd {+      fromEPollFd :: CInt+    } deriving (Eq, Show)++data Event = Event {+      eventTypes :: EventType+    , eventFd    :: Fd+    } deriving (Show)++instance Storable Event where+    sizeOf    _ = #size struct epoll_event+    alignment _ = alignment (undefined :: CInt)++    peek ptr = do+        ets <- #{peek struct epoll_event, events} ptr+        ed  <- #{peek struct epoll_event, data.fd}   ptr+        let !ev = Event (EventType ets) ed+        return ev++    poke ptr e = do+        #{poke struct epoll_event, events} ptr (unEventType $ eventTypes e)+        #{poke struct epoll_event, data.fd}   ptr (eventFd e)++newtype ControlOp = ControlOp CInt++#{enum ControlOp, ControlOp+ , controlOpAdd    = EPOLL_CTL_ADD+ , controlOpModify = EPOLL_CTL_MOD+ , controlOpDelete = EPOLL_CTL_DEL+ }++newtype EventType = EventType {+      unEventType :: Word32+    } deriving (Show, Eq, Num, Bits)++#{enum EventType, EventType+ , epollIn  = EPOLLIN+ , epollOut = EPOLLOUT+ , epollErr = EPOLLERR+ , epollHup = EPOLLHUP+ }++-- | Create a new epoll context, returning a file descriptor associated with the context.+-- The fd may be used for subsequent calls to this epoll context.+--+-- The size parameter to epoll_create is a hint about the expected number of handles.+--+-- The file descriptor returned from epoll_create() should be destroyed via+-- a call to close() after polling is finished+--+epollCreate :: IO EPollFd+epollCreate = do+  fd <- throwErrnoIfMinus1 "epollCreate" $+        c_epoll_create 256 -- argument is ignored+  setCloseOnExec fd+  let !epollFd' = EPollFd fd+  return epollFd'++epollControl :: EPollFd -> ControlOp -> Fd -> Ptr Event -> IO ()+epollControl (EPollFd epfd) (ControlOp op) (Fd fd) event =+    throwErrnoIfMinus1_ "epollControl" $ c_epoll_ctl epfd op fd event++epollWait :: EPollFd -> Ptr Event -> Int -> Int -> IO Int+epollWait (EPollFd epfd) events numEvents timeout =+    fmap fromIntegral .+    E.throwErrnoIfMinus1NoRetry "epollWait" $+    c_epoll_wait epfd events (fromIntegral numEvents) (fromIntegral timeout)++fromEvent :: E.Event -> EventType+fromEvent e = remap E.evtRead  epollIn .|.+              remap E.evtWrite epollOut+  where remap evt to+            | e `E.eventIs` evt = to+            | otherwise         = 0++toEvent :: EventType -> E.Event+toEvent e = remap (epollIn  .|. epollErr .|. epollHup) E.evtRead `mappend`+            remap (epollOut .|. epollErr .|. epollHup) E.evtWrite+  where remap evt to+            | e .&. evt /= 0 = to+            | otherwise      = mempty++fromTimeout :: Timeout -> Int+fromTimeout Forever     = -1+fromTimeout (Timeout s) = ceiling $ 1000 * s++foreign import ccall unsafe "sys/epoll.h epoll_create"+    c_epoll_create :: CInt -> IO CInt++foreign import ccall unsafe "sys/epoll.h epoll_ctl"+    c_epoll_ctl :: CInt -> CInt -> CInt -> Ptr Event -> IO CInt++foreign import ccall safe "sys/epoll.h epoll_wait"+    c_epoll_wait :: CInt -> Ptr Event -> CInt -> CInt -> IO CInt++#endif /* defined(HAVE_EPOLL) */
+ GHC/Event/IntMap.hs view
@@ -0,0 +1,375 @@+{-# LANGUAGE CPP, MagicHash, NoImplicitPrelude #-}++-----------------------------------------------------------------------------+-- |+-- Module      :  GHC.Event.IntMap+-- Copyright   :  (c) Daan Leijen 2002+--                (c) Andriy Palamarchuk 2008+-- License     :  BSD-style+-- Maintainer  :  libraries@haskell.org+-- Stability   :  provisional+-- Portability :  portable+--+-- An efficient implementation of maps from integer keys to values.+--+-- Since many function names (but not the type name) clash with+-- "Prelude" names, this module is usually imported @qualified@, e.g.+--+-- >  import Data.IntMap (IntMap)+-- >  import qualified Data.IntMap as IntMap+--+-- The implementation is based on /big-endian patricia trees/.  This data+-- structure performs especially well on binary operations like 'union'+-- and 'intersection'.  However, my benchmarks show that it is also+-- (much) faster on insertions and deletions when compared to a generic+-- size-balanced map implementation (see "Data.Map").+--+--    * Chris Okasaki and Andy Gill,  \"/Fast Mergeable Integer Maps/\",+--      Workshop on ML, September 1998, pages 77-86,+--      <http://citeseer.ist.psu.edu/okasaki98fast.html>+--+--    * D.R. Morrison, \"/PATRICIA -- Practical Algorithm To Retrieve+--      Information Coded In Alphanumeric/\", Journal of the ACM, 15(4),+--      October 1968, pages 514-534.+--+-- Operation comments contain the operation time complexity in+-- the Big-O notation <http://en.wikipedia.org/wiki/Big_O_notation>.+-- Many operations have a worst-case complexity of /O(min(n,W))/.+-- This means that the operation can become linear in the number of+-- elements with a maximum of /W/ -- the number of bits in an 'Int'+-- (32 or 64).+-----------------------------------------------------------------------------++module GHC.Event.IntMap+    (+    -- * Map type+    IntMap+    , Key++    -- * Query+    , lookup+    , member++    -- * Construction+    , empty++    -- * Insertion+    , insertWith++    -- * Delete\/Update+    , delete+    , updateWith++    -- * Traversal+    -- ** Fold+    , foldWithKey++    -- * Conversion+    , keys+    ) where++import Data.Bits++import Data.Maybe (Maybe(..))+import GHC.Base hiding (foldr)+import GHC.Num (Num(..))+import GHC.Real (fromIntegral)+import GHC.Show (Show(showsPrec), showParen, shows, showString)++#if __GLASGOW_HASKELL__+import GHC.Word (Word(..))+#else+import Data.Word+#endif++-- | A @Nat@ is a natural machine word (an unsigned Int)+type Nat = Word++natFromInt :: Key -> Nat+natFromInt i = fromIntegral i++intFromNat :: Nat -> Key+intFromNat w = fromIntegral w++shiftRL :: Nat -> Key -> Nat+#if __GLASGOW_HASKELL__+-- GHC: use unboxing to get @shiftRL@ inlined.+shiftRL (W# x) (I# i) = W# (shiftRL# x i)+#else+shiftRL x i = shiftR x i+#endif++------------------------------------------------------------------------+-- Types++-- | A map of integers to values @a@.+data IntMap a = Nil+              | Tip {-# UNPACK #-} !Key !a+              | Bin {-# UNPACK #-} !Prefix+                    {-# UNPACK #-} !Mask+                    !(IntMap a)+                    !(IntMap a)++type Prefix = Int+type Mask   = Int+type Key    = Int++------------------------------------------------------------------------+-- Query++-- | /O(min(n,W))/ Lookup the value at a key in the map.  See also+-- 'Data.Map.lookup'.+lookup :: Key -> IntMap a -> Maybe a+lookup k t = let nk = natFromInt k in seq nk (lookupN nk t)++lookupN :: Nat -> IntMap a -> Maybe a+lookupN k t+  = case t of+      Bin _ m l r+        | zeroN k (natFromInt m) -> lookupN k l+        | otherwise              -> lookupN k r+      Tip kx x+        | (k == natFromInt kx)  -> Just x+        | otherwise             -> Nothing+      Nil -> Nothing++-- | /O(min(n,W))/. Is the key a member of the map?+--+-- > member 5 (fromList [(5,'a'), (3,'b')]) == True+-- > member 1 (fromList [(5,'a'), (3,'b')]) == False++member :: Key -> IntMap a -> Bool+member k m+  = case lookup k m of+      Nothing -> False+      Just _  -> True++------------------------------------------------------------------------+-- Construction++-- | /O(1)/ The empty map.+--+-- > empty      == fromList []+-- > size empty == 0+empty :: IntMap a+empty = Nil++------------------------------------------------------------------------+-- Insert++-- | /O(min(n,W))/ Insert with a function, combining new value and old+-- value.  @insertWith f key value mp@ will insert the pair (key,+-- value) into @mp@ if key does not exist in the map.  If the key does+-- exist, the function will insert the pair (key, f new_value+-- old_value).  The result is a pair where the first element is the+-- old value, if one was present, and the second is the modified map.+insertWith :: (a -> a -> a) -> Key -> a -> IntMap a -> (Maybe a, IntMap a)+insertWith f k x t = case t of+    Bin p m l r+        | nomatch k p m -> (Nothing, join k (Tip k x) p t)+        | zero k m      -> let (found, l') = insertWith f k x l+                           in (found, Bin p m l' r)+        | otherwise     -> let (found, r') = insertWith f k x r+                           in (found, Bin p m l r')+    Tip ky y+        | k == ky       -> (Just y, Tip k (f x y))+        | otherwise     -> (Nothing, join k (Tip k x) ky t)+    Nil                 -> (Nothing, Tip k x)+++------------------------------------------------------------------------+-- Delete/Update++-- | /O(min(n,W))/. Delete a key and its value from the map.  When the+-- key is not a member of the map, the original map is returned.  The+-- result is a pair where the first element is the value associated+-- with the deleted key, if one existed, and the second element is the+-- modified map.+delete :: Key -> IntMap a -> (Maybe a, IntMap a)+delete k t = case t of+   Bin p m l r+        | nomatch k p m -> (Nothing, t)+        | zero k m      -> let (found, l') = delete k l+                           in (found, bin p m l' r)+        | otherwise     -> let (found, r') = delete k r+                           in (found, bin p m l r')+   Tip ky y+        | k == ky       -> (Just y, Nil)+        | otherwise     -> (Nothing, t)+   Nil                  -> (Nothing, Nil)++updateWith :: (a -> Maybe a) -> Key -> IntMap a -> (Maybe a, IntMap a)+updateWith f k t = case t of+    Bin p m l r+        | nomatch k p m -> (Nothing, t)+        | zero k m      -> let (found, l') = updateWith f k l+                           in (found, bin p m l' r)+        | otherwise     -> let (found, r') = updateWith f k r+                           in (found, bin p m l r')+    Tip ky y+        | k == ky       -> case (f y) of+                               Just y' -> (Just y, Tip ky y')+                               Nothing -> (Just y, Nil)+        | otherwise     -> (Nothing, t)+    Nil                 -> (Nothing, Nil)+-- | /O(n)/. Fold the keys and values in the map, such that+-- @'foldWithKey' f z == 'Prelude.foldr' ('uncurry' f) z . 'toAscList'@.+-- For example,+--+-- > keys map = foldWithKey (\k x ks -> k:ks) [] map+--+-- > let f k a result = result ++ "(" ++ (show k) ++ ":" ++ a ++ ")"+-- > foldWithKey f "Map: " (fromList [(5,"a"), (3,"b")]) == "Map: (5:a)(3:b)"++foldWithKey :: (Key -> a -> b -> b) -> b -> IntMap a -> b+foldWithKey f z t+  = foldr f z t++-- | /O(n)/. Convert the map to a list of key\/value pairs.+--+-- > toList (fromList [(5,"a"), (3,"b")]) == [(3,"b"), (5,"a")]+-- > toList empty == []++toList :: IntMap a -> [(Key,a)]+toList t+  = foldWithKey (\k x xs -> (k,x):xs) [] t++foldr :: (Key -> a -> b -> b) -> b -> IntMap a -> b+foldr f z t+  = case t of+      Bin 0 m l r | m < 0 -> foldr' f (foldr' f z l) r  -- put negative numbers before.+      Bin _ _ _ _ -> foldr' f z t+      Tip k x     -> f k x z+      Nil         -> z++foldr' :: (Key -> a -> b -> b) -> b -> IntMap a -> b+foldr' f z t+  = case t of+      Bin _ _ l r -> foldr' f (foldr' f z r) l+      Tip k x     -> f k x z+      Nil         -> z++-- | /O(n)/. Return all keys of the map in ascending order.+--+-- > keys (fromList [(5,"a"), (3,"b")]) == [3,5]+-- > keys empty == []++keys  :: IntMap a -> [Key]+keys m+  = foldWithKey (\k _ ks -> k:ks) [] m++------------------------------------------------------------------------+-- Eq++instance Eq a => Eq (IntMap a) where+    t1 == t2 = equal t1 t2+    t1 /= t2 = nequal t1 t2++equal :: Eq a => IntMap a -> IntMap a -> Bool+equal (Bin p1 m1 l1 r1) (Bin p2 m2 l2 r2)+    = (m1 == m2) && (p1 == p2) && (equal l1 l2) && (equal r1 r2)+equal (Tip kx x) (Tip ky y)+    = (kx == ky) && (x==y)+equal Nil Nil = True+equal _   _   = False++nequal :: Eq a => IntMap a -> IntMap a -> Bool+nequal (Bin p1 m1 l1 r1) (Bin p2 m2 l2 r2)+    = (m1 /= m2) || (p1 /= p2) || (nequal l1 l2) || (nequal r1 r2)+nequal (Tip kx x) (Tip ky y)+    = (kx /= ky) || (x/=y)+nequal Nil Nil = False+nequal _   _   = True++instance Show a => Show (IntMap a) where+  showsPrec d m   = showParen (d > 10) $+    showString "fromList " . shows (toList m)++------------------------------------------------------------------------+-- Utility functions++join :: Prefix -> IntMap a -> Prefix -> IntMap a -> IntMap a+join p1 t1 p2 t2+  | zero p1 m = Bin p m t1 t2+  | otherwise = Bin p m t2 t1+  where+    m = branchMask p1 p2+    p = mask p1 m++-- | @bin@ assures that we never have empty trees within a tree.+bin :: Prefix -> Mask -> IntMap a -> IntMap a -> IntMap a+bin _ _ l Nil = l+bin _ _ Nil r = r+bin p m l r   = Bin p m l r++------------------------------------------------------------------------+-- Endian independent bit twiddling++zero :: Key -> Mask -> Bool+zero i m = (natFromInt i) .&. (natFromInt m) == 0++nomatch :: Key -> Prefix -> Mask -> Bool+nomatch i p m = (mask i m) /= p++mask :: Key -> Mask -> Prefix+mask i m = maskW (natFromInt i) (natFromInt m)++zeroN :: Nat -> Nat -> Bool+zeroN i m = (i .&. m) == 0++------------------------------------------------------------------------+-- Big endian operations++maskW :: Nat -> Nat -> Prefix+maskW i m = intFromNat (i .&. (complement (m-1) `xor` m))++branchMask :: Prefix -> Prefix -> Mask+branchMask p1 p2+    = intFromNat (highestBitMask (natFromInt p1 `xor` natFromInt p2))++{-+Finding the highest bit mask in a word [x] can be done efficiently in+three ways:++* convert to a floating point value and the mantissa tells us the+  [log2(x)] that corresponds with the highest bit position. The mantissa+  is retrieved either via the standard C function [frexp] or by some bit+  twiddling on IEEE compatible numbers (float). Note that one needs to+  use at least [double] precision for an accurate mantissa of 32 bit+  numbers.++* use bit twiddling, a logarithmic sequence of bitwise or's and shifts (bit).++* use processor specific assembler instruction (asm).++The most portable way would be [bit], but is it efficient enough?+I have measured the cycle counts of the different methods on an AMD+Athlon-XP 1800 (~ Pentium III 1.8Ghz) using the RDTSC instruction:++highestBitMask: method  cycles+                --------------+                 frexp   200+                 float    33+                 bit      11+                 asm      12++Wow, the bit twiddling is on today's RISC like machines even faster+than a single CISC instruction (BSR)!+-}++-- | @highestBitMask@ returns a word where only the highest bit is+-- set.  It is found by first setting all bits in lower positions than+-- the highest bit and than taking an exclusive or with the original+-- value.  Allthough the function may look expensive, GHC compiles+-- this into excellent C code that subsequently compiled into highly+-- efficient machine code. The algorithm is derived from Jorg Arndt's+-- FXT library.+highestBitMask :: Nat -> Nat+highestBitMask x0+  = case (x0 .|. shiftRL x0 1) of+     x1 -> case (x1 .|. shiftRL x1 2) of+      x2 -> case (x2 .|. shiftRL x2 4) of+       x3 -> case (x3 .|. shiftRL x3 8) of+        x4 -> case (x4 .|. shiftRL x4 16) of+         x5 -> case (x5 .|. shiftRL x5 32) of   -- for 64 bit platforms+          x6 -> (x6 `xor` (shiftRL x6 1))
+ GHC/Event/Internal.hs view
@@ -0,0 +1,139 @@+{-# LANGUAGE ExistentialQuantification, NoImplicitPrelude #-}++module GHC.Event.Internal+    (+    -- * Event back end+      Backend+    , backend+    , delete+    , poll+    , modifyFd+    -- * Event type+    , Event+    , evtRead+    , evtWrite+    , evtClose+    , eventIs+    -- * Timeout type+    , Timeout(..)+    -- * Helpers+    , throwErrnoIfMinus1NoRetry+    ) where++import Data.Bits ((.|.), (.&.))+import Data.List (foldl', intercalate)+import Data.Monoid (Monoid(..))+import Foreign.C.Error (eINTR, getErrno, throwErrno)+import System.Posix.Types (Fd)+import GHC.Base+import GHC.Num (Num(..))+import GHC.Show (Show(..))+import GHC.List (filter, null)++-- | An I\/O event.+newtype Event = Event Int+    deriving (Eq)++evtNothing :: Event+evtNothing = Event 0+{-# INLINE evtNothing #-}++-- | Data is available to be read.+evtRead :: Event+evtRead = Event 1+{-# INLINE evtRead #-}++-- | The file descriptor is ready to accept a write.+evtWrite :: Event+evtWrite = Event 2+{-# INLINE evtWrite #-}++-- | Another thread closed the file descriptor.+evtClose :: Event+evtClose = Event 4+{-# INLINE evtClose #-}++eventIs :: Event -> Event -> Bool+eventIs (Event a) (Event b) = a .&. b /= 0++instance Show Event where+    show e = '[' : (intercalate "," . filter (not . null) $+                    [evtRead `so` "evtRead",+                     evtWrite `so` "evtWrite",+                     evtClose `so` "evtClose"]) ++ "]"+        where ev `so` disp | e `eventIs` ev = disp+                           | otherwise      = ""++instance Monoid Event where+    mempty  = evtNothing+    mappend = evtCombine+    mconcat = evtConcat++evtCombine :: Event -> Event -> Event+evtCombine (Event a) (Event b) = Event (a .|. b)+{-# INLINE evtCombine #-}++evtConcat :: [Event] -> Event+evtConcat = foldl' evtCombine evtNothing+{-# INLINE evtConcat #-}++-- | A type alias for timeouts, specified in seconds.+data Timeout = Timeout {-# UNPACK #-} !Double+             | Forever+               deriving (Show)++-- | Event notification backend.+data Backend = forall a. Backend {+      _beState :: !a++    -- | Poll backend for new events.  The provided callback is called+    -- once per file descriptor with new events.+    , _bePoll :: a                          -- backend state+              -> Timeout                    -- timeout in milliseconds+              -> (Fd -> Event -> IO ())     -- I/O callback+              -> IO ()++    -- | Register, modify, or unregister interest in the given events+    -- on the given file descriptor.+    , _beModifyFd :: a+                  -> Fd       -- file descriptor+                  -> Event    -- old events to watch for ('mempty' for new)+                  -> Event    -- new events to watch for ('mempty' to delete)+                  -> IO ()++    , _beDelete :: a -> IO ()+    }++backend :: (a -> Timeout -> (Fd -> Event -> IO ()) -> IO ())+        -> (a -> Fd -> Event -> Event -> IO ())+        -> (a -> IO ())+        -> a+        -> Backend+backend bPoll bModifyFd bDelete state = Backend state bPoll bModifyFd bDelete+{-# INLINE backend #-}++poll :: Backend -> Timeout -> (Fd -> Event -> IO ()) -> IO ()+poll (Backend bState bPoll _ _) = bPoll bState+{-# INLINE poll #-}++modifyFd :: Backend -> Fd -> Event -> Event -> IO ()+modifyFd (Backend bState _ bModifyFd _) = bModifyFd bState+{-# INLINE modifyFd #-}++delete :: Backend -> IO ()+delete (Backend bState _ _ bDelete) = bDelete bState+{-# INLINE delete #-}++-- | Throw an 'IOError' corresponding to the current value of+-- 'getErrno' if the result value of the 'IO' action is -1 and+-- 'getErrno' is not 'eINTR'.  If the result value is -1 and+-- 'getErrno' returns 'eINTR' 0 is returned.  Otherwise the result+-- value is returned.+throwErrnoIfMinus1NoRetry :: Num a => String -> IO a -> IO a+throwErrnoIfMinus1NoRetry loc f = do+    res <- f+    if res == -1+        then do+            err <- getErrno+            if err == eINTR then return 0 else throwErrno loc+        else return res
+ GHC/Event/KQueue.hsc view
@@ -0,0 +1,303 @@+{-# LANGUAGE CPP+           , ForeignFunctionInterface+           , GeneralizedNewtypeDeriving+           , NoImplicitPrelude+           , RecordWildCards+           , BangPatterns+  #-}++module GHC.Event.KQueue+    (+      new+    , available+    ) where++import qualified GHC.Event.Internal as E++#include "EventConfig.h"+#if !defined(HAVE_KQUEUE)+import GHC.Base++new :: IO E.Backend+new = error "KQueue back end not implemented for this platform"++available :: Bool+available = False+{-# INLINE available #-}+#else++import Control.Concurrent.MVar (MVar, newMVar, swapMVar, withMVar)+import Control.Monad (when, unless)+import Data.Bits (Bits(..))+import Data.Word (Word16, Word32)+import Foreign.C.Error (throwErrnoIfMinus1)+import Foreign.C.Types (CInt, CLong, CTime)+import Foreign.Marshal.Alloc (alloca)+import Foreign.Ptr (Ptr, nullPtr)+import Foreign.Storable (Storable(..))+import GHC.Base+import GHC.Enum (toEnum)+import GHC.Err (undefined)+import GHC.Num (Num(..))+import GHC.Real (ceiling, floor, fromIntegral)+import GHC.Show (Show(show))+import GHC.Event.Internal (Timeout(..))+import System.Posix.Internals (c_close)+import System.Posix.Types (Fd(..))+import qualified GHC.Event.Array as A++#if defined(HAVE_KEVENT64)+import Data.Int (Int64)+import Data.Word (Word64)+import Foreign.C.Types (CUInt)+#else+import Foreign.C.Types (CIntPtr, CUIntPtr)+#endif++#include <sys/types.h>+#include <sys/event.h>+#include <sys/time.h>++-- Handle brokenness on some BSD variants, notably OS X up to at least+-- 10.6.  If NOTE_EOF isn't available, we have no way to receive a+-- notification from the kernel when we reach EOF on a plain file.+#ifndef NOTE_EOF+# define NOTE_EOF 0+#endif++available :: Bool+available = True+{-# INLINE available #-}++------------------------------------------------------------------------+-- Exported interface++data EventQueue = EventQueue {+      eqFd       :: {-# UNPACK #-} !QueueFd+    , eqChanges  :: {-# UNPACK #-} !(MVar (A.Array Event))+    , eqEvents   :: {-# UNPACK #-} !(A.Array Event)+    }++new :: IO E.Backend+new = do+  qfd <- kqueue+  changesArr <- A.empty+  changes <- newMVar changesArr +  events <- A.new 64+  let !be = E.backend poll modifyFd delete (EventQueue qfd changes events)+  return be++delete :: EventQueue -> IO ()+delete q = do+  _ <- c_close . fromQueueFd . eqFd $ q+  return ()++modifyFd :: EventQueue -> Fd -> E.Event -> E.Event -> IO ()+modifyFd q fd oevt nevt = withMVar (eqChanges q) $ \ch -> do+  let addChange filt flag = A.snoc ch $ event fd filt flag noteEOF+  when (oevt `E.eventIs` E.evtRead)  $ addChange filterRead flagDelete+  when (oevt `E.eventIs` E.evtWrite) $ addChange filterWrite flagDelete+  when (nevt `E.eventIs` E.evtRead)  $ addChange filterRead flagAdd+  when (nevt `E.eventIs` E.evtWrite) $ addChange filterWrite flagAdd++poll :: EventQueue+     -> Timeout+     -> (Fd -> E.Event -> IO ())+     -> IO ()+poll EventQueue{..} tout f = do+    changesArr <- A.empty+    changes <- swapMVar eqChanges changesArr+    changesLen <- A.length changes+    len <- A.length eqEvents+    when (changesLen > len) $ A.ensureCapacity eqEvents (2 * changesLen)+    n <- A.useAsPtr changes $ \changesPtr chLen ->+           A.unsafeLoad eqEvents $ \evPtr evCap ->+             withTimeSpec (fromTimeout tout) $+               kevent eqFd changesPtr chLen evPtr evCap++    unless (n == 0) $ do+        cap <- A.capacity eqEvents+        when (n == cap) $ A.ensureCapacity eqEvents (2 * cap)+        A.forM_ eqEvents $ \e -> f (fromIntegral (ident e)) (toEvent (filter e))++------------------------------------------------------------------------+-- FFI binding++newtype QueueFd = QueueFd {+      fromQueueFd :: CInt+    } deriving (Eq, Show)++#if defined(HAVE_KEVENT64)+data Event = KEvent64 {+      ident  :: {-# UNPACK #-} !Word64+    , filter :: {-# UNPACK #-} !Filter+    , flags  :: {-# UNPACK #-} !Flag+    , fflags :: {-# UNPACK #-} !FFlag+    , data_  :: {-# UNPACK #-} !Int64+    , udata  :: {-# UNPACK #-} !Word64+    , ext0   :: {-# UNPACK #-} !Word64+    , ext1   :: {-# UNPACK #-} !Word64+    } deriving Show++event :: Fd -> Filter -> Flag -> FFlag -> Event+event fd filt flag fflag = KEvent64 (fromIntegral fd) filt flag fflag 0 0 0 0++instance Storable Event where+    sizeOf _ = #size struct kevent64_s+    alignment _ = alignment (undefined :: CInt)++    peek ptr = do+        ident'  <- #{peek struct kevent64_s, ident} ptr+        filter' <- #{peek struct kevent64_s, filter} ptr+        flags'  <- #{peek struct kevent64_s, flags} ptr+        fflags' <- #{peek struct kevent64_s, fflags} ptr+        data'   <- #{peek struct kevent64_s, data} ptr+        udata'  <- #{peek struct kevent64_s, udata} ptr+        ext0'   <- #{peek struct kevent64_s, ext[0]} ptr+        ext1'   <- #{peek struct kevent64_s, ext[1]} ptr+        let !ev = KEvent64 ident' (Filter filter') (Flag flags') fflags' data'+                           udata' ext0' ext1'+        return ev++    poke ptr ev = do+        #{poke struct kevent64_s, ident} ptr (ident ev)+        #{poke struct kevent64_s, filter} ptr (filter ev)+        #{poke struct kevent64_s, flags} ptr (flags ev)+        #{poke struct kevent64_s, fflags} ptr (fflags ev)+        #{poke struct kevent64_s, data} ptr (data_ ev)+        #{poke struct kevent64_s, udata} ptr (udata ev)+        #{poke struct kevent64_s, ext[0]} ptr (ext0 ev)+        #{poke struct kevent64_s, ext[1]} ptr (ext1 ev)+#else+data Event = KEvent {+      ident  :: {-# UNPACK #-} !CUIntPtr+    , filter :: {-# UNPACK #-} !Filter+    , flags  :: {-# UNPACK #-} !Flag+    , fflags :: {-# UNPACK #-} !FFlag+    , data_  :: {-# UNPACK #-} !CIntPtr+    , udata  :: {-# UNPACK #-} !(Ptr ())+    } deriving Show++event :: Fd -> Filter -> Flag -> FFlag -> Event+event fd filt flag fflag = KEvent (fromIntegral fd) filt flag fflag 0 nullPtr++instance Storable Event where+    sizeOf _ = #size struct kevent+    alignment _ = alignment (undefined :: CInt)++    peek ptr = do+        ident'  <- #{peek struct kevent, ident} ptr+        filter' <- #{peek struct kevent, filter} ptr+        flags'  <- #{peek struct kevent, flags} ptr+        fflags' <- #{peek struct kevent, fflags} ptr+        data'   <- #{peek struct kevent, data} ptr+        udata'  <- #{peek struct kevent, udata} ptr+        let !ev = KEvent ident' (Filter filter') (Flag flags') fflags' data'+                         udata'+        return ev++    poke ptr ev = do+        #{poke struct kevent, ident} ptr (ident ev)+        #{poke struct kevent, filter} ptr (filter ev)+        #{poke struct kevent, flags} ptr (flags ev)+        #{poke struct kevent, fflags} ptr (fflags ev)+        #{poke struct kevent, data} ptr (data_ ev)+        #{poke struct kevent, udata} ptr (udata ev)+#endif++newtype FFlag = FFlag Word32+    deriving (Eq, Show, Storable)++#{enum FFlag, FFlag+ , noteEOF = NOTE_EOF+ }++newtype Flag = Flag Word16+    deriving (Eq, Show, Storable)++#{enum Flag, Flag+ , flagAdd     = EV_ADD+ , flagDelete  = EV_DELETE+ }++newtype Filter = Filter Word16+    deriving (Bits, Eq, Num, Show, Storable)++#{enum Filter, Filter+ , filterRead   = EVFILT_READ+ , filterWrite  = EVFILT_WRITE+ }++data TimeSpec = TimeSpec {+      tv_sec  :: {-# UNPACK #-} !CTime+    , tv_nsec :: {-# UNPACK #-} !CLong+    }++instance Storable TimeSpec where+    sizeOf _ = #size struct timespec+    alignment _ = alignment (undefined :: CInt)++    peek ptr = do+        tv_sec'  <- #{peek struct timespec, tv_sec} ptr+        tv_nsec' <- #{peek struct timespec, tv_nsec} ptr+        let !ts = TimeSpec tv_sec' tv_nsec'+        return ts++    poke ptr ts = do+        #{poke struct timespec, tv_sec} ptr (tv_sec ts)+        #{poke struct timespec, tv_nsec} ptr (tv_nsec ts)++kqueue :: IO QueueFd+kqueue = QueueFd `fmap` throwErrnoIfMinus1 "kqueue" c_kqueue++-- TODO: We cannot retry on EINTR as the timeout would be wrong.+-- Perhaps we should just return without calling any callbacks.+kevent :: QueueFd -> Ptr Event -> Int -> Ptr Event -> Int -> Ptr TimeSpec+       -> IO Int+kevent k chs chlen evs evlen ts+    = fmap fromIntegral $ E.throwErrnoIfMinus1NoRetry "kevent" $+#if defined(HAVE_KEVENT64)+      c_kevent64 k chs (fromIntegral chlen) evs (fromIntegral evlen) 0 ts+#else+      c_kevent k chs (fromIntegral chlen) evs (fromIntegral evlen) ts+#endif++withTimeSpec :: TimeSpec -> (Ptr TimeSpec -> IO a) -> IO a+withTimeSpec ts f =+    if tv_sec ts < 0 then+        f nullPtr+      else+        alloca $ \ptr -> poke ptr ts >> f ptr++fromTimeout :: Timeout -> TimeSpec+fromTimeout Forever     = TimeSpec (-1) (-1)+fromTimeout (Timeout s) = TimeSpec (toEnum sec) (toEnum nanosec)+  where+    sec :: Int+    sec     = floor s++    nanosec :: Int+    nanosec = ceiling $ (s - fromIntegral sec) * 1000000000++toEvent :: Filter -> E.Event+toEvent (Filter f)+    | f == (#const EVFILT_READ) = E.evtRead+    | f == (#const EVFILT_WRITE) = E.evtWrite+    | otherwise = error $ "toEvent: unknown filter " ++ show f++foreign import ccall unsafe "kqueue"+    c_kqueue :: IO CInt++#if defined(HAVE_KEVENT64)+foreign import ccall safe "kevent64"+    c_kevent64 :: QueueFd -> Ptr Event -> CInt -> Ptr Event -> CInt -> CUInt+               -> Ptr TimeSpec -> IO CInt+#elif defined(HAVE_KEVENT)+foreign import ccall safe "kevent"+    c_kevent :: QueueFd -> Ptr Event -> CInt -> Ptr Event -> CInt+             -> Ptr TimeSpec -> IO CInt+#else+#error no kevent system call available!?+#endif++#endif /* defined(HAVE_KQUEUE) */
+ GHC/Event/Manager.hs view
@@ -0,0 +1,406 @@+{-# LANGUAGE BangPatterns+           , CPP+           , ExistentialQuantification+           , NoImplicitPrelude+           , RecordWildCards+           , TypeSynonymInstances+           , FlexibleInstances+  #-}++module GHC.Event.Manager+    ( -- * Types+      EventManager++      -- * Creation+    , new+    , newWith+    , newDefaultBackend++      -- * Running+    , finished+    , loop+    , step+    , shutdown+    , cleanup+    , wakeManager++      -- * Registering interest in I/O events+    , Event+    , evtRead+    , evtWrite+    , IOCallback+    , FdKey(keyFd)+    , registerFd_+    , registerFd+    , unregisterFd_+    , unregisterFd+    , closeFd++      -- * Registering interest in timeout events+    , TimeoutCallback+    , TimeoutKey+    , registerTimeout+    , updateTimeout+    , unregisterTimeout+    ) where++#include "EventConfig.h"++------------------------------------------------------------------------+-- Imports++import Control.Concurrent.MVar (MVar, modifyMVar, newMVar, readMVar)+import Control.Exception (finally)+import Control.Monad ((=<<), forM_, liftM, sequence_, when)+import Data.IORef (IORef, atomicModifyIORef, mkWeakIORef, newIORef, readIORef,+                   writeIORef)+import Data.Maybe (Maybe(..))+import Data.Monoid (mappend, mconcat, mempty)+import GHC.Base+import GHC.Conc.Signal (runHandlers)+import GHC.List (filter)+import GHC.Num (Num(..))+import GHC.Real ((/), fromIntegral )+import GHC.Show (Show(..))+import GHC.Event.Clock (getCurrentTime)+import GHC.Event.Control+import GHC.Event.Internal (Backend, Event, evtClose, evtRead, evtWrite,+                           Timeout(..))+import GHC.Event.Unique (Unique, UniqueSource, newSource, newUnique)+import System.Posix.Types (Fd)++import qualified GHC.Event.IntMap as IM+import qualified GHC.Event.Internal as I+import qualified GHC.Event.PSQ as Q++#if defined(HAVE_KQUEUE)+import qualified GHC.Event.KQueue as KQueue+#elif defined(HAVE_EPOLL)+import qualified GHC.Event.EPoll  as EPoll+#elif defined(HAVE_POLL)+import qualified GHC.Event.Poll   as Poll+#else+# error not implemented for this operating system+#endif++------------------------------------------------------------------------+-- Types++data FdData = FdData {+      fdKey       :: {-# UNPACK #-} !FdKey+    , fdEvents    :: {-# UNPACK #-} !Event+    , _fdCallback :: !IOCallback+    }++-- | A file descriptor registration cookie.+data FdKey = FdKey {+      keyFd     :: {-# UNPACK #-} !Fd+    , keyUnique :: {-# UNPACK #-} !Unique+    } deriving (Eq, Show)++-- | Callback invoked on I/O events.+type IOCallback = FdKey -> Event -> IO ()++-- | A timeout registration cookie.+newtype TimeoutKey   = TK Unique+    deriving (Eq)++-- | Callback invoked on timeout events.+type TimeoutCallback = IO ()++data State = Created+           | Running+           | Dying+           | Finished+             deriving (Eq, Show)++-- | A priority search queue, with timeouts as priorities.+type TimeoutQueue = Q.PSQ TimeoutCallback++{-+Instead of directly modifying the 'TimeoutQueue' in+e.g. 'registerTimeout' we keep a list of edits to perform, in the form+of a chain of function closures, and have the I/O manager thread+perform the edits later.  This exist to address the following GC+problem:++Since e.g. 'registerTimeout' doesn't force the evaluation of the+thunks inside the 'emTimeouts' IORef a number of thunks build up+inside the IORef.  If the I/O manager thread doesn't evaluate these+thunks soon enough they'll get promoted to the old generation and+become roots for all subsequent minor GCs.++When the thunks eventually get evaluated they will each create a new+intermediate 'TimeoutQueue' that immediately becomes garbage.  Since+the thunks serve as roots until the next major GC these intermediate+'TimeoutQueue's will get copied unnecesarily in the next minor GC,+increasing GC time.  This problem is known as "floating garbage".++Keeping a list of edits doesn't stop this from happening but makes the+amount of data that gets copied smaller.++TODO: Evaluate the content of the IORef to WHNF on each insert once+this bug is resolved: http://hackage.haskell.org/trac/ghc/ticket/3838+-}++-- | An edit to apply to a 'TimeoutQueue'.+type TimeoutEdit = TimeoutQueue -> TimeoutQueue++-- | The event manager state.+data EventManager = EventManager+    { emBackend      :: !Backend+    , emFds          :: {-# UNPACK #-} !(MVar (IM.IntMap [FdData]))+    , emTimeouts     :: {-# UNPACK #-} !(IORef TimeoutEdit)+    , emState        :: {-# UNPACK #-} !(IORef State)+    , emUniqueSource :: {-# UNPACK #-} !UniqueSource+    , emControl      :: {-# UNPACK #-} !Control+    }++------------------------------------------------------------------------+-- Creation++handleControlEvent :: EventManager -> FdKey -> Event -> IO ()+handleControlEvent mgr reg _evt = do+  msg <- readControlMessage (emControl mgr) (keyFd reg)+  case msg of+    CMsgWakeup      -> return ()+    CMsgDie         -> writeIORef (emState mgr) Finished+    CMsgSignal fp s -> runHandlers fp s++newDefaultBackend :: IO Backend+#if defined(HAVE_KQUEUE)+newDefaultBackend = KQueue.new+#elif defined(HAVE_EPOLL)+newDefaultBackend = EPoll.new+#elif defined(HAVE_POLL)+newDefaultBackend = Poll.new+#else+newDefaultBackend = error "no back end for this platform"+#endif++-- | Create a new event manager.+new :: IO EventManager+new = newWith =<< newDefaultBackend++newWith :: Backend -> IO EventManager+newWith be = do+  iofds <- newMVar IM.empty+  timeouts <- newIORef id+  ctrl <- newControl+  state <- newIORef Created+  us <- newSource+  _ <- mkWeakIORef state $ do+               st <- atomicModifyIORef state $ \s -> (Finished, s)+               when (st /= Finished) $ do+                 I.delete be+                 closeControl ctrl+  let mgr = EventManager { emBackend = be+                         , emFds = iofds+                         , emTimeouts = timeouts+                         , emState = state+                         , emUniqueSource = us+                         , emControl = ctrl+                         }+  _ <- registerFd_ mgr (handleControlEvent mgr) (controlReadFd ctrl) evtRead+  _ <- registerFd_ mgr (handleControlEvent mgr) (wakeupReadFd ctrl) evtRead+  return mgr++-- | Asynchronously shuts down the event manager, if running.+shutdown :: EventManager -> IO ()+shutdown mgr = do+  state <- atomicModifyIORef (emState mgr) $ \s -> (Dying, s)+  when (state == Running) $ sendDie (emControl mgr)++finished :: EventManager -> IO Bool+finished mgr = (== Finished) `liftM` readIORef (emState mgr)++cleanup :: EventManager -> IO ()+cleanup EventManager{..} = do+  writeIORef emState Finished+  I.delete emBackend+  closeControl emControl++------------------------------------------------------------------------+-- Event loop++-- | Start handling events.  This function loops until told to stop,+-- using 'shutdown'.+--+-- /Note/: This loop can only be run once per 'EventManager', as it+-- closes all of its control resources when it finishes.+loop :: EventManager -> IO ()+loop mgr@EventManager{..} = do+  state <- atomicModifyIORef emState $ \s -> case s of+    Created -> (Running, s)+    _       -> (s, s)+  case state of+    Created -> go Q.empty `finally` cleanup mgr+    Dying   -> cleanup mgr+    _       -> do cleanup mgr+                  error $ "GHC.Event.Manager.loop: state is already " +++                      show state+ where+  go q = do (running, q') <- step mgr q+            when running $ go q'++step :: EventManager -> TimeoutQueue -> IO (Bool, TimeoutQueue)+step mgr@EventManager{..} tq = do+  (timeout, q') <- mkTimeout tq+  I.poll emBackend timeout (onFdEvent mgr)+  state <- readIORef emState+  state `seq` return (state == Running, q')+ where++  -- | Call all expired timer callbacks and return the time to the+  -- next timeout.+  mkTimeout :: TimeoutQueue -> IO (Timeout, TimeoutQueue)+  mkTimeout q = do+      now <- getCurrentTime+      applyEdits <- atomicModifyIORef emTimeouts $ \f -> (id, f)+      let (expired, q'') = let q' = applyEdits q in q' `seq` Q.atMost now q'+      sequence_ $ map Q.value expired+      let timeout = case Q.minView q'' of+            Nothing             -> Forever+            Just (Q.E _ t _, _) ->+                -- This value will always be positive since the call+                -- to 'atMost' above removed any timeouts <= 'now'+                let t' = t - now in t' `seq` Timeout t'+      return (timeout, q'')++------------------------------------------------------------------------+-- Registering interest in I/O events++-- | Register interest in the given events, without waking the event+-- manager thread.  The 'Bool' return value indicates whether the+-- event manager ought to be woken.+registerFd_ :: EventManager -> IOCallback -> Fd -> Event+            -> IO (FdKey, Bool)+registerFd_ EventManager{..} cb fd evs = do+  u <- newUnique emUniqueSource+  modifyMVar emFds $ \oldMap -> do+    let fd'  = fromIntegral fd+        reg  = FdKey fd u+        !fdd = FdData reg evs cb+        (!newMap, (oldEvs, newEvs)) =+            case IM.insertWith (++) fd' [fdd] oldMap of+              (Nothing,   n) -> (n, (mempty, evs))+              (Just prev, n) -> (n, pairEvents prev newMap fd')+        modify = oldEvs /= newEvs+    when modify $ I.modifyFd emBackend fd oldEvs newEvs+    return (newMap, (reg, modify))+{-# INLINE registerFd_ #-}++-- | @registerFd mgr cb fd evs@ registers interest in the events @evs@+-- on the file descriptor @fd@.  @cb@ is called for each event that+-- occurs.  Returns a cookie that can be handed to 'unregisterFd'.+registerFd :: EventManager -> IOCallback -> Fd -> Event -> IO FdKey+registerFd mgr cb fd evs = do+  (r, wake) <- registerFd_ mgr cb fd evs+  when wake $ wakeManager mgr+  return r+{-# INLINE registerFd #-}++-- | Wake up the event manager.+wakeManager :: EventManager -> IO ()+wakeManager mgr = sendWakeup (emControl mgr)++eventsOf :: [FdData] -> Event+eventsOf = mconcat . map fdEvents++pairEvents :: [FdData] -> IM.IntMap [FdData] -> Int -> (Event, Event)+pairEvents prev m fd = let l = eventsOf prev+                           r = case IM.lookup fd m of+                                 Nothing  -> mempty+                                 Just fds -> eventsOf fds+                       in (l, r)++-- | Drop a previous file descriptor registration, without waking the+-- event manager thread.  The return value indicates whether the event+-- manager ought to be woken.+unregisterFd_ :: EventManager -> FdKey -> IO Bool+unregisterFd_ EventManager{..} (FdKey fd u) =+  modifyMVar emFds $ \oldMap -> do+    let dropReg cbs = case filter ((/= u) . keyUnique . fdKey) cbs of+                          []   -> Nothing+                          cbs' -> Just cbs'+        fd' = fromIntegral fd+        (!newMap, (oldEvs, newEvs)) =+            case IM.updateWith dropReg fd' oldMap of+              (Nothing,   _)    -> (oldMap, (mempty, mempty))+              (Just prev, newm) -> (newm, pairEvents prev newm fd')+        modify = oldEvs /= newEvs+    when modify $ I.modifyFd emBackend fd oldEvs newEvs+    return (newMap, modify)++-- | Drop a previous file descriptor registration.+unregisterFd :: EventManager -> FdKey -> IO ()+unregisterFd mgr reg = do+  wake <- unregisterFd_ mgr reg+  when wake $ wakeManager mgr++-- | Close a file descriptor in a race-safe way.+closeFd :: EventManager -> (Fd -> IO ()) -> Fd -> IO ()+closeFd mgr close fd = do+  fds <- modifyMVar (emFds mgr) $ \oldMap -> do+    close fd+    case IM.delete (fromIntegral fd) oldMap of+      (Nothing,  _)       -> return (oldMap, [])+      (Just fds, !newMap) -> do+        when (eventsOf fds /= mempty) $ wakeManager mgr+        return (newMap, fds)+  forM_ fds $ \(FdData reg ev cb) -> cb reg (ev `mappend` evtClose)++------------------------------------------------------------------------+-- Registering interest in timeout events++-- | Register a timeout in the given number of microseconds.  The+-- returned 'TimeoutKey' can be used to later unregister or update the+-- timeout.  The timeout is automatically unregistered after the given+-- time has passed.+registerTimeout :: EventManager -> Int -> TimeoutCallback -> IO TimeoutKey+registerTimeout mgr us cb = do+  !key <- newUnique (emUniqueSource mgr)+  if us <= 0 then cb+    else do+      now <- getCurrentTime+      let expTime = fromIntegral us / 1000000.0 + now++      -- We intentionally do not evaluate the modified map to WHNF here.+      -- Instead, we leave a thunk inside the IORef and defer its+      -- evaluation until mkTimeout in the event loop.  This is a+      -- workaround for a nasty IORef contention problem that causes the+      -- thread-delay benchmark to take 20 seconds instead of 0.2.+      atomicModifyIORef (emTimeouts mgr) $ \f ->+          let f' = (Q.insert key expTime cb) . f in (f', ())+      wakeManager mgr+  return $ TK key++-- | Unregister an active timeout.+unregisterTimeout :: EventManager -> TimeoutKey -> IO ()+unregisterTimeout mgr (TK key) = do+  atomicModifyIORef (emTimeouts mgr) $ \f ->+      let f' = (Q.delete key) . f in (f', ())+  wakeManager mgr++-- | Update an active timeout to fire in the given number of+-- microseconds.+updateTimeout :: EventManager -> TimeoutKey -> Int -> IO ()+updateTimeout mgr (TK key) us = do+  now <- getCurrentTime+  let expTime = fromIntegral us / 1000000.0 + now++  atomicModifyIORef (emTimeouts mgr) $ \f ->+      let f' = (Q.adjust (const expTime) key) . f in (f', ())+  wakeManager mgr++------------------------------------------------------------------------+-- Utilities++-- | Call the callbacks corresponding to the given file descriptor.+onFdEvent :: EventManager -> Fd -> Event -> IO ()+onFdEvent mgr fd evs = do+  fds <- readMVar (emFds mgr)+  case IM.lookup (fromIntegral fd) fds of+      Just cbs -> forM_ cbs $ \(FdData reg ev cb) ->+                    when (evs `I.eventIs` ev) $ cb reg evs+      Nothing  -> return ()
+ GHC/Event/PSQ.hs view
@@ -0,0 +1,483 @@+{-# LANGUAGE BangPatterns, NoImplicitPrelude #-}++-- Copyright (c) 2008, Ralf Hinze+-- All rights reserved.+--+-- Redistribution and use in source and binary forms, with or without+-- modification, are permitted provided that the following conditions+-- are met:+--+--     * Redistributions of source code must retain the above+--       copyright notice, this list of conditions and the following+--       disclaimer.+--+--     * Redistributions in binary form must reproduce the above+--       copyright notice, this list of conditions and the following+--       disclaimer in the documentation and/or other materials+--       provided with the distribution.+--+--     * The names of the contributors may not be used to endorse or+--       promote products derived from this software without specific+--       prior written permission.+--+-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+-- "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+-- LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS+-- FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE+-- COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,+-- INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES+-- (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR+-- SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)+-- HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,+-- STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)+-- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED+-- OF THE POSSIBILITY OF SUCH DAMAGE.++-- | A /priority search queue/ (henceforth /queue/) efficiently+-- supports the operations of both a search tree and a priority queue.+-- An 'Elem'ent is a product of a key, a priority, and a+-- value. Elements can be inserted, deleted, modified and queried in+-- logarithmic time, and the element with the least priority can be+-- retrieved in constant time.  A queue can be built from a list of+-- elements, sorted by keys, in linear time.+--+-- This implementation is due to Ralf Hinze with some modifications by+-- Scott Dillard and Johan Tibell.+--+-- * Hinze, R., /A Simple Implementation Technique for Priority Search+-- Queues/, ICFP 2001, pp. 110-121+--+-- <http://citeseer.ist.psu.edu/hinze01simple.html>+module GHC.Event.PSQ+    (+    -- * Binding Type+    Elem(..)+    , Key+    , Prio++    -- * Priority Search Queue Type+    , PSQ++    -- * Query+    , size+    , null+    , lookup++    -- * Construction+    , empty+    , singleton++    -- * Insertion+    , insert++    -- * Delete/Update+    , delete+    , adjust++    -- * Conversion+    , toList+    , toAscList+    , toDescList+    , fromList++    -- * Min+    , findMin+    , deleteMin+    , minView+    , atMost+    ) where++import Data.Maybe (Maybe(..))+import GHC.Base+import GHC.Num (Num(..))+import GHC.Show (Show(showsPrec))+import GHC.Event.Unique (Unique)++-- | @E k p@ binds the key @k@ with the priority @p@.+data Elem a = E+    { key   :: {-# UNPACK #-} !Key+    , prio  :: {-# UNPACK #-} !Prio+    , value :: a+    } deriving (Eq, Show)++------------------------------------------------------------------------+-- | A mapping from keys @k@ to priorites @p@.++type Prio = Double+type Key = Unique++data PSQ a = Void+           | Winner {-# UNPACK #-} !(Elem a)+                    !(LTree a)+                    {-# UNPACK #-} !Key  -- max key+           deriving (Eq, Show)++-- | /O(1)/ The number of elements in a queue.+size :: PSQ a -> Int+size Void            = 0+size (Winner _ lt _) = 1 + size' lt++-- | /O(1)/ True if the queue is empty.+null :: PSQ a -> Bool+null Void           = True+null (Winner _ _ _) = False++-- | /O(log n)/ The priority and value of a given key, or Nothing if+-- the key is not bound.+lookup :: Key -> PSQ a -> Maybe (Prio, a)+lookup k q = case tourView q of+    Null -> Nothing+    Single (E k' p v)+        | k == k'   -> Just (p, v)+        | otherwise -> Nothing+    tl `Play` tr+        | k <= maxKey tl -> lookup k tl+        | otherwise      -> lookup k tr++------------------------------------------------------------------------+-- Construction++empty :: PSQ a+empty = Void++-- | /O(1)/ Build a queue with one element.+singleton :: Key -> Prio -> a -> PSQ a+singleton k p v = Winner (E k p v) Start k++------------------------------------------------------------------------+-- Insertion++-- | /O(log n)/ Insert a new key, priority and value in the queue.  If+-- the key is already present in the queue, the associated priority+-- and value are replaced with the supplied priority and value.+insert :: Key -> Prio -> a -> PSQ a -> PSQ a+insert k p v q = case q of+    Void -> singleton k p v+    Winner (E k' p' v') Start _ -> case compare k k' of+        LT -> singleton k  p  v  `play` singleton k' p' v'+        EQ -> singleton k  p  v+        GT -> singleton k' p' v' `play` singleton k  p  v+    Winner e (RLoser _ e' tl m tr) m'+        | k <= m    -> insert k p v (Winner e tl m) `play` (Winner e' tr m')+        | otherwise -> (Winner e tl m) `play` insert k p v (Winner e' tr m')+    Winner e (LLoser _ e' tl m tr) m'+        | k <= m    -> insert k p v (Winner e' tl m) `play` (Winner e tr m')+        | otherwise -> (Winner e' tl m) `play` insert k p v (Winner e tr m')++------------------------------------------------------------------------+-- Delete/Update++-- | /O(log n)/ Delete a key and its priority and value from the+-- queue.  When the key is not a member of the queue, the original+-- queue is returned.+delete :: Key -> PSQ a -> PSQ a+delete k q = case q of+    Void -> empty+    Winner (E k' p v) Start _+        | k == k'   -> empty+        | otherwise -> singleton k' p v+    Winner e (RLoser _ e' tl m tr) m'+        | k <= m    -> delete k (Winner e tl m) `play` (Winner e' tr m')+        | otherwise -> (Winner e tl m) `play` delete k (Winner e' tr m')+    Winner e (LLoser _ e' tl m tr) m'+        | k <= m    -> delete k (Winner e' tl m) `play` (Winner e tr m')+        | otherwise -> (Winner e' tl m) `play` delete k (Winner e tr m')++-- | /O(log n)/ Update a priority at a specific key with the result+-- of the provided function.  When the key is not a member of the+-- queue, the original queue is returned.+adjust :: (Prio -> Prio) -> Key -> PSQ a -> PSQ a+adjust f k q0 =  go q0+  where+    go q = case q of+        Void -> empty+        Winner (E k' p v) Start _+            | k == k'   -> singleton k' (f p) v+            | otherwise -> singleton k' p v+        Winner e (RLoser _ e' tl m tr) m'+            | k <= m    -> go (Winner e tl m) `unsafePlay` (Winner e' tr m')+            | otherwise -> (Winner e tl m) `unsafePlay` go (Winner e' tr m')+        Winner e (LLoser _ e' tl m tr) m'+            | k <= m    -> go (Winner e' tl m) `unsafePlay` (Winner e tr m')+            | otherwise -> (Winner e' tl m) `unsafePlay` go (Winner e tr m')+{-# INLINE adjust #-}++------------------------------------------------------------------------+-- Conversion++-- | /O(n*log n)/ Build a queue from a list of key/priority/value+-- tuples.  If the list contains more than one priority and value for+-- the same key, the last priority and value for the key is retained.+fromList :: [Elem a] -> PSQ a+fromList = foldr (\(E k p v) q -> insert k p v q) empty++-- | /O(n)/ Convert to a list of key/priority/value tuples.+toList :: PSQ a -> [Elem a]+toList = toAscList++-- | /O(n)/ Convert to an ascending list.+toAscList :: PSQ a -> [Elem a]+toAscList q  = seqToList (toAscLists q)++toAscLists :: PSQ a -> Sequ (Elem a)+toAscLists q = case tourView q of+    Null         -> emptySequ+    Single e     -> singleSequ e+    tl `Play` tr -> toAscLists tl <> toAscLists tr++-- | /O(n)/ Convert to a descending list.+toDescList :: PSQ a -> [ Elem a ]+toDescList q = seqToList (toDescLists q)++toDescLists :: PSQ a -> Sequ (Elem a)+toDescLists q = case tourView q of+    Null         -> emptySequ+    Single e     -> singleSequ e+    tl `Play` tr -> toDescLists tr <> toDescLists tl++------------------------------------------------------------------------+-- Min++-- | /O(1)/ The element with the lowest priority.+findMin :: PSQ a -> Maybe (Elem a)+findMin Void           = Nothing+findMin (Winner e _ _) = Just e++-- | /O(log n)/ Delete the element with the lowest priority.  Returns+-- an empty queue if the queue is empty.+deleteMin :: PSQ a -> PSQ a+deleteMin Void           = Void+deleteMin (Winner _ t m) = secondBest t m++-- | /O(log n)/ Retrieve the binding with the least priority, and the+-- rest of the queue stripped of that binding.+minView :: PSQ a -> Maybe (Elem a, PSQ a)+minView Void           = Nothing+minView (Winner e t m) = Just (e, secondBest t m)++secondBest :: LTree a -> Key -> PSQ a+secondBest Start _                 = Void+secondBest (LLoser _ e tl m tr) m' = Winner e tl m `play` secondBest tr m'+secondBest (RLoser _ e tl m tr) m' = secondBest tl m `play` Winner e tr m'++-- | /O(r*(log n - log r))/ Return a list of elements ordered by+-- key whose priorities are at most @pt@.+atMost :: Prio -> PSQ a -> ([Elem a], PSQ a)+atMost pt q = let (sequ, q') = atMosts pt q+              in (seqToList sequ, q')++atMosts :: Prio -> PSQ a -> (Sequ (Elem a), PSQ a)+atMosts !pt q = case q of+    (Winner e _ _)+        | prio e > pt -> (emptySequ, q)+    Void              -> (emptySequ, Void)+    Winner e Start _  -> (singleSequ e, Void)+    Winner e (RLoser _ e' tl m tr) m' ->+        let (sequ, q')   = atMosts pt (Winner e tl m)+            (sequ', q'') = atMosts pt (Winner e' tr m')+        in (sequ <> sequ', q' `play` q'')+    Winner e (LLoser _ e' tl m tr) m' ->+        let (sequ, q')   = atMosts pt (Winner e' tl m)+            (sequ', q'') = atMosts pt (Winner e tr m')+        in (sequ <> sequ', q' `play` q'')++------------------------------------------------------------------------+-- Loser tree++type Size = Int++data LTree a = Start+             | LLoser {-# UNPACK #-} !Size+                      {-# UNPACK #-} !(Elem a)+                      !(LTree a)+                      {-# UNPACK #-} !Key  -- split key+                      !(LTree a)+             | RLoser {-# UNPACK #-} !Size+                      {-# UNPACK #-} !(Elem a)+                      !(LTree a)+                      {-# UNPACK #-} !Key  -- split key+                      !(LTree a)+             deriving (Eq, Show)++size' :: LTree a -> Size+size' Start              = 0+size' (LLoser s _ _ _ _) = s+size' (RLoser s _ _ _ _) = s++left, right :: LTree a -> LTree a++left Start                = moduleError "left" "empty loser tree"+left (LLoser _ _ tl _ _ ) = tl+left (RLoser _ _ tl _ _ ) = tl++right Start                = moduleError "right" "empty loser tree"+right (LLoser _ _ _  _ tr) = tr+right (RLoser _ _ _  _ tr) = tr++maxKey :: PSQ a -> Key+maxKey Void           = moduleError "maxKey" "empty queue"+maxKey (Winner _ _ m) = m++lloser, rloser :: Key -> Prio -> a -> LTree a -> Key -> LTree a -> LTree a+lloser k p v tl m tr = LLoser (1 + size' tl + size' tr) (E k p v) tl m tr+rloser k p v tl m tr = RLoser (1 + size' tl + size' tr) (E k p v) tl m tr++------------------------------------------------------------------------+-- Balancing++-- | Balance factor+omega :: Int+omega = 4++lbalance, rbalance :: Key -> Prio -> a -> LTree a -> Key -> LTree a -> LTree a++lbalance k p v l m r+    | size' l + size' r < 2     = lloser        k p v l m r+    | size' r > omega * size' l = lbalanceLeft  k p v l m r+    | size' l > omega * size' r = lbalanceRight k p v l m r+    | otherwise                 = lloser        k p v l m r++rbalance k p v l m r+    | size' l + size' r < 2     = rloser        k p v l m r+    | size' r > omega * size' l = rbalanceLeft  k p v l m r+    | size' l > omega * size' r = rbalanceRight k p v l m r+    | otherwise                 = rloser        k p v l m r++lbalanceLeft :: Key -> Prio -> a -> LTree a -> Key -> LTree a -> LTree a+lbalanceLeft  k p v l m r+    | size' (left r) < size' (right r) = lsingleLeft  k p v l m r+    | otherwise                        = ldoubleLeft  k p v l m r++lbalanceRight :: Key -> Prio -> a -> LTree a -> Key -> LTree a -> LTree a+lbalanceRight k p v l m r+    | size' (left l) > size' (right l) = lsingleRight k p v l m r+    | otherwise                        = ldoubleRight k p v l m r++rbalanceLeft :: Key -> Prio -> a -> LTree a -> Key -> LTree a -> LTree a+rbalanceLeft  k p v l m r+    | size' (left r) < size' (right r) = rsingleLeft  k p v l m r+    | otherwise                        = rdoubleLeft  k p v l m r++rbalanceRight :: Key -> Prio -> a -> LTree a -> Key -> LTree a -> LTree a+rbalanceRight k p v l m r+    | size' (left l) > size' (right l) = rsingleRight k p v l m r+    | otherwise                        = rdoubleRight k p v l m r++lsingleLeft :: Key -> Prio -> a -> LTree a -> Key -> LTree a -> LTree a+lsingleLeft k1 p1 v1 t1 m1 (LLoser _ (E k2 p2 v2) t2 m2 t3)+    | p1 <= p2  = lloser k1 p1 v1 (rloser k2 p2 v2 t1 m1 t2) m2 t3+    | otherwise = lloser k2 p2 v2 (lloser k1 p1 v1 t1 m1 t2) m2 t3+lsingleLeft k1 p1 v1 t1 m1 (RLoser _ (E k2 p2 v2) t2 m2 t3) =+    rloser k2 p2 v2 (lloser k1 p1 v1 t1 m1 t2) m2 t3+lsingleLeft _ _ _ _ _ _ = moduleError "lsingleLeft" "malformed tree"++rsingleLeft :: Key -> Prio -> a -> LTree a -> Key -> LTree a -> LTree a+rsingleLeft k1 p1 v1 t1 m1 (LLoser _ (E k2 p2 v2) t2 m2 t3) =+    rloser k1 p1 v1 (rloser k2 p2 v2 t1 m1 t2) m2 t3+rsingleLeft k1 p1 v1 t1 m1 (RLoser _ (E k2 p2 v2) t2 m2 t3) =+    rloser k2 p2 v2 (rloser k1 p1 v1 t1 m1 t2) m2 t3+rsingleLeft _ _ _ _ _ _ = moduleError "rsingleLeft" "malformed tree"++lsingleRight :: Key -> Prio -> a -> LTree a -> Key -> LTree a -> LTree a+lsingleRight k1 p1 v1 (LLoser _ (E k2 p2 v2) t1 m1 t2) m2 t3 =+    lloser k2 p2 v2 t1 m1 (lloser k1 p1 v1 t2 m2 t3)+lsingleRight k1 p1 v1 (RLoser _ (E k2 p2 v2) t1 m1 t2) m2 t3 =+    lloser k1 p1 v1 t1 m1 (lloser k2 p2 v2 t2 m2 t3)+lsingleRight _ _ _ _ _ _ = moduleError "lsingleRight" "malformed tree"++rsingleRight :: Key -> Prio -> a -> LTree a -> Key -> LTree a -> LTree a+rsingleRight k1 p1 v1 (LLoser _ (E k2 p2 v2) t1 m1 t2) m2 t3 =+    lloser k2 p2 v2 t1 m1 (rloser k1 p1 v1 t2 m2 t3)+rsingleRight k1 p1 v1 (RLoser _ (E k2 p2 v2) t1 m1 t2) m2 t3+    | p1 <= p2  = rloser k1 p1 v1 t1 m1 (lloser k2 p2 v2 t2 m2 t3)+    | otherwise = rloser k2 p2 v2 t1 m1 (rloser k1 p1 v1 t2 m2 t3)+rsingleRight _ _ _ _ _ _ = moduleError "rsingleRight" "malformed tree"++ldoubleLeft :: Key -> Prio -> a -> LTree a -> Key -> LTree a -> LTree a+ldoubleLeft k1 p1 v1 t1 m1 (LLoser _ (E k2 p2 v2) t2 m2 t3) =+    lsingleLeft k1 p1 v1 t1 m1 (lsingleRight k2 p2 v2 t2 m2 t3)+ldoubleLeft k1 p1 v1 t1 m1 (RLoser _ (E k2 p2 v2) t2 m2 t3) =+    lsingleLeft k1 p1 v1 t1 m1 (rsingleRight k2 p2 v2 t2 m2 t3)+ldoubleLeft _ _ _ _ _ _ = moduleError "ldoubleLeft" "malformed tree"++ldoubleRight :: Key -> Prio -> a -> LTree a -> Key -> LTree a -> LTree a+ldoubleRight k1 p1 v1 (LLoser _ (E k2 p2 v2) t1 m1 t2) m2 t3 =+    lsingleRight k1 p1 v1 (lsingleLeft k2 p2 v2 t1 m1 t2) m2 t3+ldoubleRight k1 p1 v1 (RLoser _ (E k2 p2 v2) t1 m1 t2) m2 t3 =+    lsingleRight k1 p1 v1 (rsingleLeft k2 p2 v2 t1 m1 t2) m2 t3+ldoubleRight _ _ _ _ _ _ = moduleError "ldoubleRight" "malformed tree"++rdoubleLeft :: Key -> Prio -> a -> LTree a -> Key -> LTree a -> LTree a+rdoubleLeft k1 p1 v1 t1 m1 (LLoser _ (E k2 p2 v2) t2 m2 t3) =+    rsingleLeft k1 p1 v1 t1 m1 (lsingleRight k2 p2 v2 t2 m2 t3)+rdoubleLeft k1 p1 v1 t1 m1 (RLoser _ (E k2 p2 v2) t2 m2 t3) =+    rsingleLeft k1 p1 v1 t1 m1 (rsingleRight k2 p2 v2 t2 m2 t3)+rdoubleLeft _ _ _ _ _ _ = moduleError "rdoubleLeft" "malformed tree"++rdoubleRight :: Key -> Prio -> a -> LTree a -> Key -> LTree a -> LTree a+rdoubleRight k1 p1 v1 (LLoser _ (E k2 p2 v2) t1 m1 t2) m2 t3 =+    rsingleRight k1 p1 v1 (lsingleLeft k2 p2 v2 t1 m1 t2) m2 t3+rdoubleRight k1 p1 v1 (RLoser _ (E k2 p2 v2) t1 m1 t2) m2 t3 =+    rsingleRight k1 p1 v1 (rsingleLeft k2 p2 v2 t1 m1 t2) m2 t3+rdoubleRight _ _ _ _ _ _ = moduleError "rdoubleRight" "malformed tree"++-- | Take two pennants and returns a new pennant that is the union of+-- the two with the precondition that the keys in the first tree are+-- strictly smaller than the keys in the second tree.+play :: PSQ a -> PSQ a -> PSQ a+Void `play` t' = t'+t `play` Void  = t+Winner e@(E k p v) t m `play` Winner e'@(E k' p' v') t' m'+    | p <= p'   = Winner e (rbalance k' p' v' t m t') m'+    | otherwise = Winner e' (lbalance k p v t m t') m'+{-# INLINE play #-}++-- | A version of 'play' that can be used if the shape of the tree has+-- not changed or if the tree is known to be balanced.+unsafePlay :: PSQ a -> PSQ a -> PSQ a+Void `unsafePlay` t' =  t'+t `unsafePlay` Void  =  t+Winner e@(E k p v) t m `unsafePlay` Winner e'@(E k' p' v') t' m'+    | p <= p'   = Winner e (rloser k' p' v' t m t') m'+    | otherwise = Winner e' (lloser k p v t m t') m'+{-# INLINE unsafePlay #-}++data TourView a = Null+                | Single {-# UNPACK #-} !(Elem a)+                | (PSQ a) `Play` (PSQ a)++tourView :: PSQ a -> TourView a+tourView Void               = Null+tourView (Winner e Start _) = Single e+tourView (Winner e (RLoser _ e' tl m tr) m') =+    Winner e tl m `Play` Winner e' tr m'+tourView (Winner e (LLoser _ e' tl m tr) m') =+    Winner e' tl m `Play` Winner e tr m'++------------------------------------------------------------------------+-- Utility functions++moduleError :: String -> String -> a+moduleError fun msg = error ("GHC.Event.PSQ." ++ fun ++ ':' : ' ' : msg)+{-# NOINLINE moduleError #-}++------------------------------------------------------------------------+-- Hughes's efficient sequence type++newtype Sequ a = Sequ ([a] -> [a])++emptySequ :: Sequ a+emptySequ = Sequ (\as -> as)++singleSequ :: a -> Sequ a+singleSequ a = Sequ (\as -> a : as)++(<>) :: Sequ a -> Sequ a -> Sequ a+Sequ x1 <> Sequ x2 = Sequ (\as -> x1 (x2 as))+infixr 5 <>++seqToList :: Sequ a -> [a]+seqToList (Sequ x) = x []++instance Show a => Show (Sequ a) where+    showsPrec d a = showsPrec d (seqToList a)
+ GHC/Event/Poll.hsc view
@@ -0,0 +1,162 @@+{-# LANGUAGE CPP+           , ForeignFunctionInterface+           , GeneralizedNewtypeDeriving+           , NoImplicitPrelude+           , BangPatterns+  #-}++module GHC.Event.Poll+    (+      new+    , available+    ) where++#include "EventConfig.h"++#if !defined(HAVE_POLL_H)+import GHC.Base++new :: IO E.Backend+new = error "Poll back end not implemented for this platform"++available :: Bool+available = False+{-# INLINE available #-}+#else+#include <poll.h>++import Control.Concurrent.MVar (MVar, newMVar, swapMVar)+import Control.Monad ((=<<), liftM, liftM2, unless)+import Data.Bits (Bits, (.|.), (.&.))+import Data.Maybe (Maybe(..))+import Data.Monoid (Monoid(..))+import Foreign.C.Types (CInt, CShort, CULong)+import Foreign.Ptr (Ptr)+import Foreign.Storable (Storable(..))+import GHC.Base+import GHC.Conc.Sync (withMVar)+import GHC.Err (undefined)+import GHC.Num (Num(..))+import GHC.Real (ceiling, fromIntegral)+import GHC.Show (Show)+import System.Posix.Types (Fd(..))++import qualified GHC.Event.Array as A+import qualified GHC.Event.Internal as E++available :: Bool+available = True+{-# INLINE available #-}++data Poll = Poll {+      pollChanges :: {-# UNPACK #-} !(MVar (A.Array PollFd))+    , pollFd      :: {-# UNPACK #-} !(A.Array PollFd)+    }++new :: IO E.Backend+new = E.backend poll modifyFd (\_ -> return ()) `liftM`+      liftM2 Poll (newMVar =<< A.empty) A.empty++modifyFd :: Poll -> Fd -> E.Event -> E.Event -> IO ()+modifyFd p fd oevt nevt =+  withMVar (pollChanges p) $ \ary ->+    A.snoc ary $ PollFd fd (fromEvent nevt) (fromEvent oevt)++reworkFd :: Poll -> PollFd -> IO ()+reworkFd p (PollFd fd npevt opevt) = do+  let ary = pollFd p+  if opevt == 0+    then A.snoc ary $ PollFd fd npevt 0+    else do+      found <- A.findIndex ((== fd) . pfdFd) ary+      case found of+        Nothing        -> error "reworkFd: event not found"+        Just (i,_)+          | npevt /= 0 -> A.unsafeWrite ary i $ PollFd fd npevt 0+          | otherwise  -> A.removeAt ary i++poll :: Poll+     -> E.Timeout+     -> (Fd -> E.Event -> IO ())+     -> IO ()+poll p tout f = do+  let a = pollFd p+  mods <- swapMVar (pollChanges p) =<< A.empty+  A.forM_ mods (reworkFd p)+  n <- A.useAsPtr a $ \ptr len -> E.throwErrnoIfMinus1NoRetry "c_poll" $+         c_poll ptr (fromIntegral len) (fromIntegral (fromTimeout tout))+  unless (n == 0) $ do+    A.loop a 0 $ \i e -> do+      let r = pfdRevents e+      if r /= 0+        then do f (pfdFd e) (toEvent r)+                let i' = i + 1+                return (i', i' == n)+        else return (i, True)++fromTimeout :: E.Timeout -> Int+fromTimeout E.Forever     = -1+fromTimeout (E.Timeout s) = ceiling $ 1000 * s++data PollFd = PollFd {+      pfdFd      :: {-# UNPACK #-} !Fd+    , pfdEvents  :: {-# UNPACK #-} !Event+    , pfdRevents :: {-# UNPACK #-} !Event+    } deriving (Show)++newtype Event = Event CShort+    deriving (Eq, Show, Num, Storable, Bits)++-- We have to duplicate the whole enum like this in order for the+-- hsc2hs cross-compilation mode to work+#ifdef POLLRDHUP+#{enum Event, Event+ , pollIn    = POLLIN+ , pollOut   = POLLOUT+ , pollRdHup = POLLRDHUP+ , pollErr   = POLLERR+ , pollHup   = POLLHUP+ }+#else+#{enum Event, Event+ , pollIn    = POLLIN+ , pollOut   = POLLOUT+ , pollErr   = POLLERR+ , pollHup   = POLLHUP+ }+#endif++fromEvent :: E.Event -> Event+fromEvent e = remap E.evtRead  pollIn .|.+              remap E.evtWrite pollOut+  where remap evt to+            | e `E.eventIs` evt = to+            | otherwise         = 0++toEvent :: Event -> E.Event+toEvent e = remap (pollIn .|. pollErr .|. pollHup)  E.evtRead `mappend`+            remap (pollOut .|. pollErr .|. pollHup) E.evtWrite+  where remap evt to+            | e .&. evt /= 0 = to+            | otherwise      = mempty++instance Storable PollFd where+    sizeOf _    = #size struct pollfd+    alignment _ = alignment (undefined :: CInt)++    peek ptr = do+      fd <- #{peek struct pollfd, fd} ptr+      events <- #{peek struct pollfd, events} ptr+      revents <- #{peek struct pollfd, revents} ptr+      let !pollFd' = PollFd fd events revents+      return pollFd'++    poke ptr p = do+      #{poke struct pollfd, fd} ptr (pfdFd p)+      #{poke struct pollfd, events} ptr (pfdEvents p)+      #{poke struct pollfd, revents} ptr (pfdRevents p)++foreign import ccall safe "poll.h poll"+    c_poll :: Ptr PollFd -> CULong -> CInt -> IO CInt++#endif /* defined(HAVE_POLL_H) */
+ GHC/Event/Thread.hs view
@@ -0,0 +1,150 @@+{-# LANGUAGE BangPatterns, ForeignFunctionInterface, NoImplicitPrelude #-}++module GHC.Event.Thread+    ( getSystemEventManager+    , ensureIOManagerIsRunning+    , threadWaitRead+    , threadWaitWrite+    , closeFdWith+    , threadDelay+    , registerDelay+    ) where++import Data.IORef (IORef, newIORef, readIORef, writeIORef)+import Data.Maybe (Maybe(..))+import Foreign.C.Error (eBADF, errnoToIOError)+import Foreign.Ptr (Ptr)+import GHC.Base+import GHC.Conc.Sync (TVar, ThreadId, ThreadStatus(..), atomically, forkIO,+                      labelThread, modifyMVar_, newTVar, sharedCAF,+                      threadStatus, writeTVar)+import GHC.IO (mask_, onException)+import GHC.IO.Exception (ioError)+import GHC.MVar (MVar, newEmptyMVar, newMVar, putMVar, takeMVar)+import GHC.Event.Internal (eventIs, evtClose)+import GHC.Event.Manager (Event, EventManager, evtRead, evtWrite, loop,+                             new, registerFd, unregisterFd_, registerTimeout)+import qualified GHC.Event.Manager as M+import System.IO.Unsafe (unsafePerformIO)+import System.Posix.Types (Fd)++-- | Suspends the current thread for a given number of microseconds+-- (GHC only).+--+-- There is no guarantee that the thread will be rescheduled promptly+-- when the delay has expired, but the thread will never continue to+-- run /earlier/ than specified.+threadDelay :: Int -> IO ()+threadDelay usecs = mask_ $ do+  Just mgr <- getSystemEventManager+  m <- newEmptyMVar+  reg <- registerTimeout mgr usecs (putMVar m ())+  takeMVar m `onException` M.unregisterTimeout mgr reg++-- | Set the value of returned TVar to True after a given number of+-- microseconds. The caveats associated with threadDelay also apply.+--+registerDelay :: Int -> IO (TVar Bool)+registerDelay usecs = do+  t <- atomically $ newTVar False+  Just mgr <- getSystemEventManager+  _ <- registerTimeout mgr usecs . atomically $ writeTVar t True+  return t++-- | Block the current thread until data is available to read from the+-- given file descriptor.+--+-- This will throw an 'IOError' if the file descriptor was closed+-- while this thread was blocked.  To safely close a file descriptor+-- that has been used with 'threadWaitRead', use 'closeFdWith'.+threadWaitRead :: Fd -> IO ()+threadWaitRead = threadWait evtRead+{-# INLINE threadWaitRead #-}++-- | Block the current thread until the given file descriptor can+-- accept data to write.+--+-- This will throw an 'IOError' if the file descriptor was closed+-- while this thread was blocked.  To safely close a file descriptor+-- that has been used with 'threadWaitWrite', use 'closeFdWith'.+threadWaitWrite :: Fd -> IO ()+threadWaitWrite = threadWait evtWrite+{-# INLINE threadWaitWrite #-}++-- | Close a file descriptor in a concurrency-safe way.+--+-- Any threads that are blocked on the file descriptor via+-- 'threadWaitRead' or 'threadWaitWrite' will be unblocked by having+-- IO exceptions thrown.+closeFdWith :: (Fd -> IO ())        -- ^ Action that performs the close.+            -> Fd                   -- ^ File descriptor to close.+            -> IO ()+closeFdWith close fd = do+  Just mgr <- getSystemEventManager+  M.closeFd mgr close fd++threadWait :: Event -> Fd -> IO ()+threadWait evt fd = mask_ $ do+  m <- newEmptyMVar+  Just mgr <- getSystemEventManager+  reg <- registerFd mgr (\reg e -> unregisterFd_ mgr reg >> putMVar m e) fd evt+  evt' <- takeMVar m `onException` unregisterFd_ mgr reg+  if evt' `eventIs` evtClose+    then ioError $ errnoToIOError "threadWait" eBADF Nothing Nothing+    else return ()++-- | Retrieve the system event manager.+--+-- This function always returns 'Just' the system event manager when using the+-- threaded RTS and 'Nothing' otherwise.+getSystemEventManager :: IO (Maybe EventManager)+getSystemEventManager = readIORef eventManager++foreign import ccall unsafe "getOrSetSystemEventThreadEventManagerStore"+    getOrSetSystemEventThreadEventManagerStore :: Ptr a -> IO (Ptr a)++eventManager :: IORef (Maybe EventManager)+eventManager = unsafePerformIO $ do+    em <- newIORef Nothing+    sharedCAF em getOrSetSystemEventThreadEventManagerStore+{-# NOINLINE eventManager #-}++foreign import ccall unsafe "getOrSetSystemEventThreadIOManagerThreadStore"+    getOrSetSystemEventThreadIOManagerThreadStore :: Ptr a -> IO (Ptr a)++{-# NOINLINE ioManager #-}+ioManager :: MVar (Maybe ThreadId)+ioManager = unsafePerformIO $ do+   m <- newMVar Nothing+   sharedCAF m getOrSetSystemEventThreadIOManagerThreadStore++ensureIOManagerIsRunning :: IO ()+ensureIOManagerIsRunning+  | not threaded = return ()+  | otherwise = modifyMVar_ ioManager $ \old -> do+  let create = do+        !mgr <- new+        writeIORef eventManager $ Just mgr+        !t <- forkIO $ loop mgr+        labelThread t "IOManager"+        return $ Just t+  case old of+    Nothing            -> create+    st@(Just t) -> do+      s <- threadStatus t+      case s of+        ThreadFinished -> create+        ThreadDied     -> do +          -- Sanity check: if the thread has died, there is a chance+          -- that event manager is still alive. This could happend during+          -- the fork, for example. In this case we should clean up+          -- open pipes and everything else related to the event manager.+          -- See #4449+          mem <- readIORef eventManager+          _ <- case mem of+                 Nothing -> return ()+                 Just em -> M.cleanup em+          create+        _other         -> return st++foreign import ccall unsafe "rtsSupportsBoundThreads" threaded :: Bool
+ GHC/Event/Unique.hs view
@@ -0,0 +1,40 @@+{-# LANGUAGE BangPatterns, GeneralizedNewtypeDeriving, NoImplicitPrelude #-}+module GHC.Event.Unique+    (+      UniqueSource+    , Unique(..)+    , newSource+    , newUnique+    ) where++import Data.Int (Int64)+import GHC.Base+import GHC.Conc.Sync (TVar, atomically, newTVarIO, readTVar, writeTVar)+import GHC.Num (Num(..))+import GHC.Show (Show(..))++-- We used to use IORefs here, but Simon switched us to STM when we+-- found that our use of atomicModifyIORef was subject to a severe RTS+-- performance problem when used in a tight loop from multiple+-- threads: http://hackage.haskell.org/trac/ghc/ticket/3838+--+-- There seems to be no performance cost to using a TVar instead.++newtype UniqueSource = US (TVar Int64)++newtype Unique = Unique { asInt64 :: Int64 }+    deriving (Eq, Ord, Num)++instance Show Unique where+    show = show . asInt64++newSource :: IO UniqueSource+newSource = US `fmap` newTVarIO 0++newUnique :: UniqueSource -> IO Unique+newUnique (US ref) = atomically $ do+  u <- readTVar ref+  let !u' = u+1+  writeTVar ref u'+  return $ Unique u'+{-# INLINE newUnique #-}
GHC/Exception.lhs view
@@ -1,5 +1,10 @@ \begin{code}-{-# OPTIONS_GHC -XNoImplicitPrelude #-}+{-# LANGUAGE Trustworthy #-}+{-# LANGUAGE NoImplicitPrelude+           , ExistentialQuantification+           , MagicHash+           , DeriveDataTypeable+  #-} {-# OPTIONS_HADDOCK hide #-} ----------------------------------------------------------------------------- -- |@@ -20,6 +25,7 @@  import Data.Maybe import {-# SOURCE #-} Data.Typeable (Typeable, cast)+   -- loop: Data.Typeable -> GHC.Err -> GHC.Exception import GHC.Base import GHC.Show \end{code}@@ -57,7 +63,7 @@ @ThatException@ as exceptions:  @-*Main> throw ThisException `catch` \e -> putStrLn (\"Caught \" ++ show (e :: MyException))+*Main> throw ThisException \`catch\` \\e -> putStrLn (\"Caught \" ++ show (e :: MyException)) Caught ThisException @
GHC/Exts.hs view
@@ -1,3 +1,5 @@+{-# LANGUAGE MagicHash, UnboxedTuples, DeriveDataTypeable #-}+ ----------------------------------------------------------------------------- -- | -- Module      :  GHC.Exts@@ -58,7 +60,6 @@ import GHC.Magic import GHC.Word import GHC.Int--- import GHC.Float import GHC.Ptr import Data.String import Data.List
+ GHC/Fingerprint.hs view
@@ -0,0 +1,75 @@+{-# LANGUAGE NoImplicitPrelude+           , BangPatterns+           , ForeignFunctionInterface+           , EmptyDataDecls+  #-}+-- ----------------------------------------------------------------------------+-- +--  (c) The University of Glasgow 2006+--+-- Fingerprints for recompilation checking and ABI versioning, and+-- implementing fast comparison of Typeable.+--+-- ----------------------------------------------------------------------------++module GHC.Fingerprint (+        Fingerprint(..), fingerprint0, +        fingerprintData,+        fingerprintString,+        fingerprintFingerprints+   ) where++import GHC.IO+import GHC.Base+import GHC.Num+import GHC.List+import GHC.Real+import Foreign+import Foreign.C++import GHC.Fingerprint.Type++-- for SIZEOF_STRUCT_MD5CONTEXT:+#include "HsBaseConfig.h"++-- XXX instance Storable Fingerprint+-- defined in Foreign.Storable to avoid orphan instance++fingerprint0 :: Fingerprint+fingerprint0 = Fingerprint 0 0++fingerprintFingerprints :: [Fingerprint] -> Fingerprint+fingerprintFingerprints fs = unsafeDupablePerformIO $+  withArrayLen fs $ \len p -> do+    fingerprintData (castPtr p) (len * sizeOf (head fs))++fingerprintData :: Ptr Word8 -> Int -> IO Fingerprint+fingerprintData buf len = do+  allocaBytes SIZEOF_STRUCT_MD5CONTEXT $ \pctxt -> do+    c_MD5Init pctxt+    c_MD5Update pctxt buf (fromIntegral len)+    allocaBytes 16 $ \pdigest -> do+      c_MD5Final pdigest pctxt+      peek (castPtr pdigest :: Ptr Fingerprint)++-- This is duplicated in compiler/utils/Fingerprint.hsc+fingerprintString :: String -> Fingerprint+fingerprintString str = unsafeDupablePerformIO $+  withArrayLen word8s $ \len p ->+     fingerprintData p len+    where word8s = concatMap f str+          f c = let w32 :: Word32+                    w32 = fromIntegral (ord c)+                in [fromIntegral (w32 `shiftR` 24),+                    fromIntegral (w32 `shiftR` 16),+                    fromIntegral (w32 `shiftR` 8),+                    fromIntegral w32]++data MD5Context++foreign import ccall unsafe "MD5Init"+   c_MD5Init   :: Ptr MD5Context -> IO ()+foreign import ccall unsafe "MD5Update"+   c_MD5Update :: Ptr MD5Context -> Ptr Word8 -> CInt -> IO ()+foreign import ccall unsafe "MD5Final"+   c_MD5Final  :: Ptr Word8 -> Ptr MD5Context -> IO ()
+ GHC/Fingerprint.hs-boot view
@@ -0,0 +1,12 @@+{-# LANGUAGE NoImplicitPrelude #-}+module GHC.Fingerprint (+        fingerprintString,+        fingerprintFingerprints+  ) where++import GHC.Base+import GHC.Fingerprint.Type++fingerprintFingerprints :: [Fingerprint] -> Fingerprint+fingerprintString :: String -> Fingerprint+
+ GHC/Fingerprint/Type.hs view
@@ -0,0 +1,19 @@+{-# LANGUAGE NoImplicitPrelude #-}+-- ----------------------------------------------------------------------------+-- +--  (c) The University of Glasgow 2006+--+-- Fingerprints for recompilation checking and ABI versioning, and+-- implementing fast comparison of Typeable.+--+-- ----------------------------------------------------------------------------++module GHC.Fingerprint.Type (Fingerprint(..)) where++import GHC.Base+import GHC.Word++-- Using 128-bit MD5 fingerprints for now.++data Fingerprint = Fingerprint {-# UNPACK #-} !Word64 {-# UNPACK #-} !Word64+  deriving (Eq, Ord)
GHC/Float.lhs view
@@ -1,9 +1,16 @@ \begin{code}-{-# OPTIONS_GHC -XNoImplicitPrelude #-}+{-# LANGUAGE Trustworthy #-}+{-# LANGUAGE CPP+           , NoImplicitPrelude+           , MagicHash+           , UnboxedTuples+           , ForeignFunctionInterface+  #-} -- We believe we could deorphan this module, by moving lots of things -- around, but we haven't got there yet: {-# OPTIONS_GHC -fno-warn-orphans #-} {-# OPTIONS_HADDOCK hide #-}+ ----------------------------------------------------------------------------- -- | -- Module      :  GHC.Float@@ -21,7 +28,8 @@ #include "ieee-flpt.h"  -- #hide-module GHC.Float( module GHC.Float, Float(..), Double(..), Float#, Double# )+module GHC.Float( module GHC.Float, Float(..), Double(..), Float#, Double#+                , double2Int, int2Double, float2Int, int2Float )     where  import Data.Maybe@@ -34,6 +42,10 @@ import GHC.Num import GHC.Real import GHC.Arr+import GHC.Float.RealFracMethods+import GHC.Float.ConversionUtils+import GHC.Integer.Logarithms ( integerLogBase# )+import GHC.Integer.Logarithms.Internals  infixr 8  ** \end{code}@@ -182,28 +194,51 @@     fromInteger i = F# (floatFromInteger i)  instance  Real Float  where-    toRational x        =  (m%1)*(b%1)^^n-                           where (m,n) = decodeFloat x-                                 b     = floatRadix  x+    toRational (F# x#)  =+        case decodeFloat_Int# x# of+          (# m#, e# #)+            | e# >=# 0#                                 ->+                    (smallInteger m# `shiftLInteger` e#) :% 1+            | (int2Word# m# `and#` 1##) `eqWord#` 0##   ->+                    case elimZerosInt# m# (negateInt# e#) of+                      (# n, d# #) -> n :% shiftLInteger 1 d#+            | otherwise                                 ->+                    smallInteger m# :% shiftLInteger 1 (negateInt# e#)  instance  Fractional Float  where     (/) x y             =  divideFloat x y-    fromRational x      =  fromRat x+    fromRational (n:%0)+        | n == 0        = 0/0+        | n < 0         = (-1)/0+        | otherwise     = 1/0+    fromRational (n:%d)+        | n == 0        = encodeFloat 0 0+        | n < 0         = -(fromRat'' minEx mantDigs (-n) d)+        | otherwise     = fromRat'' minEx mantDigs n d+          where+            minEx       = FLT_MIN_EXP+            mantDigs    = FLT_MANT_DIG     recip x             =  1.0 / x -{-# RULES "truncate/Float->Int" truncate = float2Int #-}+-- RULES for Integer and Int+{-# RULES+"properFraction/Float->Integer"     properFraction = properFractionFloatInteger+"truncate/Float->Integer"           truncate = truncateFloatInteger+"floor/Float->Integer"              floor = floorFloatInteger+"ceiling/Float->Integer"            ceiling = ceilingFloatInteger+"round/Float->Integer"              round = roundFloatInteger+"properFraction/Float->Int"         properFraction = properFractionFloatInt+"truncate/Float->Int"               truncate = float2Int+"floor/Float->Int"                  floor = floorFloatInt+"ceiling/Float->Int"                ceiling = ceilingFloatInt+"round/Float->Int"                  round = roundFloatInt+  #-} instance  RealFrac Float  where -    {-# SPECIALIZE properFraction :: Float -> (Int, Float) #-}-    {-# SPECIALIZE round    :: Float -> Int #-}--    {-# SPECIALIZE properFraction :: Float  -> (Integer, Float) #-}-    {-# SPECIALIZE round    :: Float -> Integer #-}-         -- ceiling, floor, and truncate are all small-    {-# INLINE ceiling #-}-    {-# INLINE floor #-}-    {-# INLINE truncate #-}+    {-# INLINE [1] ceiling #-}+    {-# INLINE [1] floor #-}+    {-# INLINE [1] truncate #-}  -- We assume that FLT_RADIX is 2 so that we can use more efficient code #if FLT_RADIX != 2@@ -316,13 +351,30 @@   instance  Real Double  where-    toRational x        =  (m%1)*(b%1)^^n-                           where (m,n) = decodeFloat x-                                 b     = floatRadix  x+    toRational (D# x#)  =+        case decodeDoubleInteger x# of+          (# m, e# #)+            | e# >=# 0#                                         ->+                shiftLInteger m e# :% 1+            | (int2Word# (integerToInt m) `and#` 1##) `eqWord#` 0##   ->+                case elimZerosInteger m (negateInt# e#) of+                    (# n, d# #) ->  n :% shiftLInteger 1 d#+            | otherwise                                         ->+                m :% shiftLInteger 1 (negateInt# e#)  instance  Fractional Double  where     (/) x y             =  divideDouble x y-    fromRational x      =  fromRat x+    fromRational (n:%0)+        | n == 0        = 0/0+        | n < 0         = (-1)/0+        | otherwise     = 1/0+    fromRational (n:%d)+        | n == 0        = encodeFloat 0 0+        | n < 0         = -(fromRat'' minEx mantDigs (-n) d)+        | otherwise     = fromRat'' minEx mantDigs n d+          where+            minEx       = DBL_MIN_EXP+            mantDigs    = DBL_MANT_DIG     recip x             =  1.0 / x  instance  Floating Double  where@@ -346,27 +398,32 @@     acosh x = log (x + (x+1.0) * sqrt ((x-1.0)/(x+1.0)))     atanh x = 0.5 * log ((1.0+x) / (1.0-x)) -{-# RULES "truncate/Double->Int" truncate = double2Int #-}+-- RULES for Integer and Int+{-# RULES+"properFraction/Double->Integer"    properFraction = properFractionDoubleInteger+"truncate/Double->Integer"          truncate = truncateDoubleInteger+"floor/Double->Integer"             floor = floorDoubleInteger+"ceiling/Double->Integer"           ceiling = ceilingDoubleInteger+"round/Double->Integer"             round = roundDoubleInteger+"properFraction/Double->Int"        properFraction = properFractionDoubleInt+"truncate/Double->Int"              truncate = double2Int+"floor/Double->Int"                 floor = floorDoubleInt+"ceiling/Double->Int"               ceiling = ceilingDoubleInt+"round/Double->Int"                 round = roundDoubleInt+  #-} instance  RealFrac Double  where -    {-# SPECIALIZE properFraction :: Double -> (Int, Double) #-}-    {-# SPECIALIZE round    :: Double -> Int #-}--    {-# SPECIALIZE properFraction :: Double -> (Integer, Double) #-}-    {-# SPECIALIZE round    :: Double -> Integer #-}-         -- ceiling, floor, and truncate are all small-    {-# INLINE ceiling #-}-    {-# INLINE floor #-}-    {-# INLINE truncate #-}+    {-# INLINE [1] ceiling #-}+    {-# INLINE [1] floor #-}+    {-# INLINE [1] 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)+            (fromInteger m * 2 ^ n, 0.0)         else-            case (quotRem m (b^(negate n))) of { (w,r) ->+            case (quotRem m (2^(negate n))) of { (w,r) ->             (fromInteger w, encodeFloat r n)             }         }@@ -595,19 +652,19 @@   -- will have an impossibly low exponent.  Adjust for this.   (f, e) =    let n = minExp - e0 in-   if n > 0 then (f0 `div` (b^n), e0+n) else (f0, e0)+   if n > 0 then (f0 `quot` (expt b n), e0+n) else (f0, e0)   (r, s, mUp, mDn) =    if e >= 0 then-    let be = b^ e in-    if f == b^(p-1) then+    let be = expt b e in+    if f == expt b (p-1) then       (f*be*b*2, 2*b, be*b, be)     -- according to Burger and Dybvig     else       (f*be*2, 2, be, be)    else-    if e > minExp && f == b^(p-1) then-      (f*b*2, b^(-e+1)*2, b, 1)+    if e > minExp && f == expt b (p-1) then+      (f*b*2, expt b (-e+1)*2, b, 1)     else-      (f*2, b^(-e)*2, 1, 1)+      (f*2, expt b (-e)*2, 1, 1)   k :: Int   k =    let@@ -653,7 +710,7 @@    gen ds rn sN mUpN mDnN =    let-    (dn, rn') = (rn * base) `divMod` sN+    (dn, rn') = (rn * base) `quotRem` sN     mUpN' = mUpN * base     mDnN' = mDnN * base    in@@ -732,8 +789,10 @@  \begin{code} -- | Converts a 'Rational' value into any type in class 'RealFloat'.-{-# SPECIALISE fromRat :: Rational -> Double,-                          Rational -> Float #-}+{-# RULES+"fromRat/Float"     fromRat = (fromRational :: Rational -> Float)+"fromRat/Double"    fromRat = (fromRational :: Rational -> Double)+  #-} fromRat :: (RealFloat a) => Rational -> a  -- Deal with special cases first, delegating the real work to fromRat'@@ -785,27 +844,106 @@     if base == 2 && n >= minExpt && n <= maxExpt then         expts!n     else-        base^n+        if base == 10 && n <= maxExpt10 then+            expts10!n+        else+            base^n  expts :: Array Int Integer expts = array (minExpt,maxExpt) [(n,2^n) | n <- [minExpt .. maxExpt]] +maxExpt10 :: Int+maxExpt10 = 324++expts10 :: Array Int Integer+expts10 = array (minExpt,maxExpt10) [(n,10^n) | n <- [minExpt .. maxExpt10]]+ -- Compute the (floor of the) log of i in base b. -- Simplest way would be just divide i by b until it's smaller then b, but that would--- be very slow!  We are just slightly more clever.+-- be very slow!  We are just slightly more clever, except for base 2, where+-- we take advantage of the representation of Integers.+-- The general case could be improved by a lookup table for+-- approximating the result by integerLog2 i / integerLog2 b. integerLogBase :: Integer -> Integer -> Int integerLogBase b i    | i < b     = 0-   | otherwise = doDiv (i `div` (b^l)) l-       where-        -- Try squaring the base first to cut down the number of divisions.-         l = 2 * integerLogBase (b*b) i+   | b == 2    = I# (integerLog2# i)+   | otherwise = I# (integerLogBase# b i) -         doDiv :: Integer -> Int -> Int-         doDiv x y-            | x < b     = y-            | otherwise = doDiv (x `div` b) (y+1)+\end{code} +Unfortunately, the old conversion code was awfully slow due to+a) a slow integer logarithm+b) repeated calculation of gcd's++For the case of Rational's coming from a Float or Double via toRational,+we can exploit the fact that the denominator is a power of two, which for+these brings a huge speedup since we need only shift and add instead+of division.++The below is an adaption of fromRat' for the conversion to+Float or Double exploiting the know floatRadix and avoiding+divisions as much as possible.++\begin{code}+{-# SPECIALISE fromRat'' :: Int -> Int -> Integer -> Integer -> Float,+                            Int -> Int -> Integer -> Integer -> Double #-}+fromRat'' :: RealFloat a => Int -> Int -> Integer -> Integer -> a+fromRat'' minEx@(I# me#) mantDigs@(I# md#) n d =+    case integerLog2IsPowerOf2# d of+      (# ld#, pw# #)+        | pw# ==# 0# ->+          case integerLog2# n of+            ln# | ln# ># (ld# +# me#) ->+                  if ln# <# md#+                    then encodeFloat (n `shiftL` (I# (md# -# 1# -# ln#)))+                                        (I# (ln# +# 1# -# ld# -# md#))+                    else let n'  = n `shiftR` (I# (ln# +# 1# -# md#))+                             n'' = case roundingMode# n (ln# -# md#) of+                                    0# -> n'+                                    2# -> n' + 1+                                    _  -> case fromInteger n' .&. (1 :: Int) of+                                            0 -> n'+                                            _ -> n' + 1+                         in encodeFloat n'' (I# (ln# -# ld# +# 1# -# md#))+                | otherwise ->+                  case ld# +# (me# -# md#) of+                    ld'# | ld'# ># (ln# +# 1#)  -> encodeFloat 0 0+                         | ld'# ==# (ln# +# 1#) ->+                           case integerLog2IsPowerOf2# n of+                            (# _, 0# #) -> encodeFloat 0 0+                            (# _, _ #)  -> encodeFloat 1 (minEx - mantDigs)+                         | ld'# <=# 0#  ->+                           encodeFloat n (I# ((me# -# md#) -# ld'#))+                         | otherwise    ->+                           let n' = n `shiftR` (I# ld'#)+                           in case roundingMode# n (ld'# -# 1#) of+                                0# -> encodeFloat n' (minEx - mantDigs)+                                1# -> if fromInteger n' .&. (1 :: Int) == 0+                                        then encodeFloat n' (minEx-mantDigs)+                                        else encodeFloat (n' + 1) (minEx-mantDigs)+                                _  -> encodeFloat (n' + 1) (minEx-mantDigs)+        | otherwise ->+          let ln = I# (integerLog2# n)+              ld = I# ld#+              p0 = max minEx (ln - ld)+              (n', d')+                | p0 < mantDigs = (n `shiftL` (mantDigs - p0), d)+                | p0 == mantDigs = (n, d)+                | otherwise     = (n, d `shiftL` (p0 - mantDigs))+              scale p a b+                | p <= minEx-mantDigs = (p,a,b)+                | a < (b `shiftL` (mantDigs-1)) = (p-1, a `shiftL` 1, b)+                | (b `shiftL` mantDigs) <= a = (p+1, a, b `shiftL` 1)+                | otherwise = (p, a, b)+              (p', n'', d'') = scale (p0-mantDigs) n' d'+              rdq = case n'' `quotRem` d'' of+                     (q,r) -> case compare (r `shiftL` 1) d'' of+                                LT -> q+                                EQ -> if fromInteger q .&. (1 :: Int) == 0+                                        then q else q+1+                                GT -> q+1+          in  encodeFloat rdq p' \end{code}  @@ -836,12 +974,6 @@ ltFloat     (F# x) (F# y) = ltFloat# x y leFloat     (F# x) (F# y) = leFloat# x y -float2Int :: Float -> Int-float2Int   (F# x) = I# (float2Int# x)--int2Float :: Int -> Float-int2Float   (I# x) = F# (int2Float# x)- expFloat, logFloat, sqrtFloat :: Float -> Float sinFloat, cosFloat, tanFloat  :: Float -> Float asinFloat, acosFloat, atanFloat  :: Float -> Float@@ -881,12 +1013,6 @@ neDouble    (D# x) (D# y) = x /=## y ltDouble    (D# x) (D# y) = x <## y leDouble    (D# x) (D# y) = x <=## y--double2Int :: Double -> Int-double2Int   (D# x) = I# (double2Int#   x)--int2Double :: Int -> Double-int2Double   (I# x) = D# (int2Double#   x)  double2Float :: Double -> Float double2Float (D# x) = F# (double2Float# x)
+ GHC/Float/ConversionUtils.hs view
@@ -0,0 +1,97 @@+{-# LANGUAGE Trustworthy #-}+{-# LANGUAGE CPP, MagicHash, UnboxedTuples, NoImplicitPrelude #-}+{-# OPTIONS_GHC -O2 #-}+{-# OPTIONS_HADDOCK hide #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  GHC.Float.ConversionUtils+-- Copyright   :  (c) Daniel Fischer 2010+-- License     :  see libraries/base/LICENSE+--+-- Maintainer  :  cvs-ghc@haskell.org+-- Stability   :  internal+-- Portability :  non-portable (GHC Extensions)+--+-- Utilities for conversion between Double/Float and Rational+--+-----------------------------------------------------------------------------++#include "MachDeps.h"++-- #hide+module GHC.Float.ConversionUtils ( elimZerosInteger, elimZerosInt# ) where++import GHC.Base+import GHC.Integer+#if WORD_SIZE_IN_BITS < 64+import GHC.IntWord64+#endif++default ()++#if WORD_SIZE_IN_BITS < 64++#define TO64    integerToInt64++toByte64# :: Int64# -> Int#+toByte64# i = word2Int# (and# 255## (int2Word# (int64ToInt# i)))++-- Double mantissae have 53 bits, too much for Int#+elim64# :: Int64# -> Int# -> (# Integer, Int# #)+elim64# n e =+    case zeroCount (toByte64# n) of+      t | e <=# t   -> (# int64ToInteger (uncheckedIShiftRA64# n e), 0# #)+        | t <# 8#   -> (# int64ToInteger (uncheckedIShiftRA64# n t), e -# t #)+        | otherwise -> elim64# (uncheckedIShiftRA64# n 8#) (e -# 8#)++#else++#define TO64    integerToInt++-- Double mantissae fit it Int#+elim64# :: Int# -> Int# -> (# Integer, Int# #)+elim64# = elimZerosInt#++#endif++{-# INLINE elimZerosInteger #-}+elimZerosInteger :: Integer -> Int# -> (# Integer, Int# #)+elimZerosInteger m e = elim64# (TO64 m) e++elimZerosInt# :: Int# -> Int# -> (# Integer, Int# #)+elimZerosInt# n e =+    case zeroCount (toByte# n) of+      t | e <=# t   -> (# smallInteger (uncheckedIShiftRA# n e), 0# #)+        | t <# 8#   -> (# smallInteger (uncheckedIShiftRA# n t), e -# t #)+        | otherwise -> elimZerosInt# (uncheckedIShiftRA# n 8#) (e -# 8#)++{-# INLINE zeroCount #-}+zeroCount :: Int# -> Int#+zeroCount i =+    case zeroCountArr of+      BA ba -> indexInt8Array# ba i++toByte# :: Int# -> Int#+toByte# i = word2Int# (and# 255## (int2Word# i))+++data BA = BA ByteArray#++-- Number of trailing zero bits in a byte+zeroCountArr :: BA+zeroCountArr =+    let mkArr s =+          case newByteArray# 256# s of+            (# s1, mba #) ->+              case writeInt8Array# mba 0# 8# s1 of+                s2 ->+                  let fillA step val idx st+                        | idx <# 256# = case writeInt8Array# mba idx val st of+                                          nx -> fillA step val (idx +# step) nx+                        | step <# 256# = fillA (2# *# step) (val +# 1#) step  st+                        | otherwise   = st+                  in case fillA 2# 0# 1# s2 of+                       s3 -> case unsafeFreezeByteArray# mba s3 of+                                (# _, ba #) -> ba+    in case mkArr realWorld# of+        b -> BA b
+ GHC/Float/RealFracMethods.hs view
@@ -0,0 +1,342 @@+{-# LANGUAGE Trustworthy #-}+{-# LANGUAGE CPP, MagicHash, UnboxedTuples, ForeignFunctionInterface,+    NoImplicitPrelude #-}+{-# OPTIONS_HADDOCK hide #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  GHC.Float.RealFracMethods+-- Copyright   :  (c) Daniel Fischer 2010+-- License     :  see libraries/base/LICENSE+--+-- Maintainer  :  cvs-ghc@haskell.org+-- Stability   :  internal+-- Portability :  non-portable (GHC Extensions)+--+-- Methods for the RealFrac instances for 'Float' and 'Double',+-- with specialised versions for 'Int'.+--+-- Moved to their own module to not bloat GHC.Float further.+--+-----------------------------------------------------------------------------++#include "MachDeps.h"++-- #hide+module GHC.Float.RealFracMethods+    ( -- * Double methods+      -- ** Integer results+      properFractionDoubleInteger+    , truncateDoubleInteger+    , floorDoubleInteger+    , ceilingDoubleInteger+    , roundDoubleInteger+      -- ** Int results+    , properFractionDoubleInt+    , floorDoubleInt+    , ceilingDoubleInt+    , roundDoubleInt+      -- * Double/Int conversions, wrapped primops+    , double2Int+    , int2Double+      -- * Float methods+      -- ** Integer results+    , properFractionFloatInteger+    , truncateFloatInteger+    , floorFloatInteger+    , ceilingFloatInteger+    , roundFloatInteger+      -- ** Int results+    , properFractionFloatInt+    , floorFloatInt+    , ceilingFloatInt+    , roundFloatInt+      -- * Float/Int conversions, wrapped primops+    , float2Int+    , int2Float+    ) where++import GHC.Integer++import GHC.Base+import GHC.Num ()++#if WORD_SIZE_IN_BITS < 64++import GHC.IntWord64++#define TO64 integerToInt64+#define FROM64 int64ToInteger+#define MINUS64 minusInt64#+#define NEGATE64 negateInt64#++#else++#define TO64 integerToInt+#define FROM64 smallInteger+#define MINUS64 ( -# )+#define NEGATE64 negateInt#++uncheckedIShiftRA64# :: Int# -> Int# -> Int#+uncheckedIShiftRA64# = uncheckedIShiftRA#++uncheckedIShiftL64# :: Int# -> Int# -> Int#+uncheckedIShiftL64# = uncheckedIShiftL#++#endif++default ()++------------------------------------------------------------------------------+--                              Float Methods                               --+------------------------------------------------------------------------------++-- Special Functions for Int, nice, easy and fast.+-- They should be small enough to be inlined automatically.++-- We have to test for ±0.0 to avoid returning -0.0 in the second+-- component of the pair. Unfortunately the branching costs a lot+-- of performance.+properFractionFloatInt :: Float -> (Int, Float)+properFractionFloatInt (F# x) =+    if x `eqFloat#` 0.0#+        then (I# 0#, F# 0.0#)+        else case float2Int# x of+                n -> (I# n, F# (x `minusFloat#` int2Float# n))++-- truncateFloatInt = float2Int++floorFloatInt :: Float -> Int+floorFloatInt (F# x) =+    case float2Int# x of+      n | x `ltFloat#` int2Float# n -> I# (n -# 1#)+        | otherwise                 -> I# n++ceilingFloatInt :: Float -> Int+ceilingFloatInt (F# x) =+    case float2Int# x of+      n | int2Float# n `ltFloat#` x  -> I# (n +# 1#)+        | otherwise                 -> I# n++roundFloatInt :: Float -> Int+roundFloatInt x = float2Int (c_rintFloat x)++-- Functions with Integer results++-- With the new code generator in GHC 7, the explicit bit-fiddling is+-- slower than the old code for values of small modulus, but when the+-- 'Int' range is left, the bit-fiddling quickly wins big, so we use that.+-- If the methods are called on smallish values, hopefully people go+-- through Int and not larger types.++-- Note: For negative exponents, we must check the validity of the shift+-- distance for the right shifts of the mantissa.++{-# INLINE properFractionFloatInteger #-}+properFractionFloatInteger :: Float -> (Integer, Float)+properFractionFloatInteger v@(F# x) =+    case decodeFloat_Int# x of+      (# m, e #)+        | e <# 0#   ->+          case negateInt# e of+            s | s ># 23#    -> (0, v)+              | m <# 0#     ->+                case negateInt# (negateInt# m `uncheckedIShiftRA#` s) of+                  k -> (smallInteger k,+                            case m -# (k `uncheckedIShiftL#` s) of+                              r -> F# (encodeFloatInteger (smallInteger r) e))+              | otherwise           ->+                case m `uncheckedIShiftRL#` s of+                  k -> (smallInteger k,+                            case m -# (k `uncheckedIShiftL#` s) of+                              r -> F# (encodeFloatInteger (smallInteger r) e))+        | otherwise -> (shiftLInteger (smallInteger m) e, F# 0.0#)++{-# INLINE truncateFloatInteger #-}+truncateFloatInteger :: Float -> Integer+truncateFloatInteger x =+    case properFractionFloatInteger x of+      (n, _) -> n++-- floor is easier for negative numbers than truncate, so this gets its+-- own implementation, it's a little faster.+{-# INLINE floorFloatInteger #-}+floorFloatInteger :: Float -> Integer+floorFloatInteger (F# x) =+    case decodeFloat_Int# x of+      (# m, e #)+        | e <# 0#   ->+          case negateInt# e of+            s | s ># 23#    -> if m <# 0# then (-1) else 0+              | otherwise   -> smallInteger (m `uncheckedIShiftRA#` s)+        | otherwise -> shiftLInteger (smallInteger m) e++-- ceiling x = -floor (-x)+-- If giving this its own implementation is faster at all,+-- it's only marginally so, hence we keep it short.+{-# INLINE ceilingFloatInteger #-}+ceilingFloatInteger :: Float -> Integer+ceilingFloatInteger (F# x) =+    negateInteger (floorFloatInteger (F# (negateFloat# x)))++{-# INLINE roundFloatInteger #-}+roundFloatInteger :: Float -> Integer+roundFloatInteger x = float2Integer (c_rintFloat x)++------------------------------------------------------------------------------+--                              Double Methods                              --+------------------------------------------------------------------------------++-- Special Functions for Int, nice, easy and fast.+-- They should be small enough to be inlined automatically.++-- We have to test for ±0.0 to avoid returning -0.0 in the second+-- component of the pair. Unfortunately the branching costs a lot+-- of performance.+properFractionDoubleInt :: Double -> (Int, Double)+properFractionDoubleInt (D# x) =+    if x ==## 0.0##+        then (I# 0#, D# 0.0##)+        else case double2Int# x of+                n -> (I# n, D# (x -## int2Double# n))++-- truncateDoubleInt = double2Int++floorDoubleInt :: Double -> Int+floorDoubleInt (D# x) =+    case double2Int# x of+      n | x <## int2Double# n   -> I# (n -# 1#)+        | otherwise             -> I# n++ceilingDoubleInt :: Double -> Int+ceilingDoubleInt (D# x) =+    case double2Int# x of+      n | int2Double# n <## x   -> I# (n +# 1#)+        | otherwise             -> I# n++roundDoubleInt :: Double -> Int+roundDoubleInt x = double2Int (c_rintDouble x)++-- Functions with Integer results++-- The new Code generator isn't quite as good for the old 'Double' code+-- as for the 'Float' code, so for 'Double' the bit-fiddling also wins+-- when the values have small modulus.++-- When the exponent is negative, all mantissae have less than 64 bits+-- and the right shifting of sized types is much faster than that of+-- 'Integer's, especially when we can++-- Note: For negative exponents, we must check the validity of the shift+-- distance for the right shifts of the mantissa.++{-# INLINE properFractionDoubleInteger #-}+properFractionDoubleInteger :: Double -> (Integer, Double)+properFractionDoubleInteger v@(D# x) =+    case decodeDoubleInteger x of+      (# m, e #)+        | e <# 0#   ->+          case negateInt# e of+            s | s ># 52#    -> (0, v)+              | m < 0       ->+                case TO64 (negateInteger m) of+                  n ->+                    case n `uncheckedIShiftRA64#` s of+                      k ->+                        (FROM64 (NEGATE64 k),+                          case MINUS64 n (k `uncheckedIShiftL64#` s) of+                            r ->+                              D# (encodeDoubleInteger (FROM64 (NEGATE64 r)) e))+              | otherwise           ->+                case TO64 m of+                  n ->+                    case n `uncheckedIShiftRA64#` s of+                      k -> (FROM64 k,+                            case MINUS64 n (k `uncheckedIShiftL64#` s) of+                              r -> D# (encodeDoubleInteger (FROM64 r) e))+        | otherwise -> (shiftLInteger m e, D# 0.0##)++{-# INLINE truncateDoubleInteger #-}+truncateDoubleInteger :: Double -> Integer+truncateDoubleInteger x =+    case properFractionDoubleInteger x of+      (n, _) -> n++-- floor is easier for negative numbers than truncate, so this gets its+-- own implementation, it's a little faster.+{-# INLINE floorDoubleInteger #-}+floorDoubleInteger :: Double -> Integer+floorDoubleInteger (D# x) =+    case decodeDoubleInteger x of+      (# m, e #)+        | e <# 0#   ->+          case negateInt# e of+            s | s ># 52#    -> if m < 0 then (-1) else 0+              | otherwise   ->+                case TO64 m of+                  n -> FROM64 (n `uncheckedIShiftRA64#` s)+        | otherwise -> shiftLInteger m e++{-# INLINE ceilingDoubleInteger #-}+ceilingDoubleInteger :: Double -> Integer+ceilingDoubleInteger (D# x) =+    negateInteger (floorDoubleInteger (D# (negateDouble# x)))++{-# INLINE roundDoubleInteger #-}+roundDoubleInteger :: Double -> Integer+roundDoubleInteger x = double2Integer (c_rintDouble x)++-- Wrappers around double2Int#, int2Double#, float2Int# and int2Float#,+-- we need them here, so we move them from GHC.Float and re-export them+-- explicitly from there.++double2Int :: Double -> Int+double2Int (D# x) = I# (double2Int# x)++int2Double :: Int -> Double+int2Double (I# i) = D# (int2Double# i)++float2Int :: Float -> Int+float2Int (F# x) = I# (float2Int# x)++int2Float :: Int -> Float+int2Float (I# i) = F# (int2Float# i)++-- Quicker conversions from 'Double' and 'Float' to 'Integer',+-- assuming the floating point value is integral.+--+-- Note: Since the value is integral, the exponent can't be less than+-- (-TYP_MANT_DIG), so we need not check the validity of the shift+-- distance for the right shfts here.++{-# INLINE double2Integer #-}+double2Integer :: Double -> Integer+double2Integer (D# x) =+    case decodeDoubleInteger x of+      (# m, e #)+        | e <# 0#   ->+          case TO64 m of+            n -> FROM64 (n `uncheckedIShiftRA64#` negateInt# e)+        | otherwise -> shiftLInteger m e++{-# INLINE float2Integer #-}+float2Integer :: Float -> Integer+float2Integer (F# x) =+    case decodeFloat_Int# x of+      (# m, e #)+        | e <# 0#   -> smallInteger (m `uncheckedIShiftRA#` negateInt# e)+        | otherwise -> shiftLInteger (smallInteger m) e++-- Foreign imports, the rounding is done faster in C when the value+-- isn't integral, so we call out for rounding. For values of large+-- modulus, calling out to C is slower than staying in Haskell, but+-- presumably 'round' is mostly called for values with smaller modulus,+-- when calling out to C is a major win.+-- For all other functions, calling out to C gives at most a marginal+-- speedup for values of small modulus and is much slower than staying+-- in Haskell for values of large modulus, so those are done in Haskell.++foreign import ccall unsafe "rintDouble"+    c_rintDouble :: Double -> Double++foreign import ccall unsafe "rintFloat"+    c_rintFloat :: Float -> Float
+ GHC/Foreign.hs view
@@ -0,0 +1,257 @@+{-# LANGUAGE Trustworthy #-}+{-# LANGUAGE CPP, NoImplicitPrelude #-}++-----------------------------------------------------------------------------+-- |+-- Module      :  GHC.Foreign+-- Copyright   :  (c) The University of Glasgow, 2008-2011+-- License     :  see libraries/base/LICENSE+-- +-- Maintainer  :  libraries@haskell.org+-- Stability   :  internal+-- Portability :  non-portable+--+-- Foreign marshalling support for CStrings with configurable encodings+--+-----------------------------------------------------------------------------++module GHC.Foreign (+    -- * C strings with a configurable encoding+    +    -- conversion of C strings into Haskell strings+    --+    peekCString,       -- :: TextEncoding -> CString    -> IO String+    peekCStringLen,    -- :: TextEncoding -> CStringLen -> IO String+    +    -- conversion of Haskell strings into C strings+    --+    newCString,        -- :: TextEncoding -> String -> IO CString+    newCStringLen,     -- :: TextEncoding -> String -> IO CStringLen+    +    -- conversion of Haskell strings into C strings using temporary storage+    --+    withCString,       -- :: TextEncoding -> String -> (CString    -> IO a) -> IO a+    withCStringLen,    -- :: TextEncoding -> String -> (CStringLen -> IO a) -> IO a+    +    charIsRepresentable, -- :: TextEncoding -> Char -> IO Bool+  ) where++import Foreign.Marshal.Array+import Foreign.C.Types+import Foreign.Ptr+import Foreign.Storable++import Data.Word++-- Imports for the locale-encoding version of marshallers+import Control.Monad++import Data.Tuple (fst)+import Data.Maybe++import {-# SOURCE #-} System.Posix.Internals (puts)+import GHC.Show ( show )++import Foreign.Marshal.Alloc+import Foreign.ForeignPtr++import GHC.Err (undefined)+import GHC.List+import GHC.Num+import GHC.Base++import GHC.IO+import GHC.IO.Exception+import GHC.IO.Buffer+import GHC.IO.Encoding.Failure (surrogatifyRoundtripCharacter, desurrogatifyRoundtripCharacter)+import GHC.IO.Encoding.Types+++c_DEBUG_DUMP :: Bool+c_DEBUG_DUMP = False++putDebugMsg :: String -> IO ()+putDebugMsg | c_DEBUG_DUMP = puts+            | otherwise    = const (return ())+++-- These definitions are identical to those in Foreign.C.String, but copied in here to avoid a cycle:+type CString    = Ptr CChar+type CStringLen = (Ptr CChar, Int)++-- exported functions+-- ------------------++-- | Marshal a NUL terminated C string into a Haskell string.+--+peekCString    :: TextEncoding -> CString -> IO String+peekCString enc cp = do+    sz <- lengthArray0 nUL cp+    peekEncodedCString enc (cp, sz * cCharSize)++-- | Marshal a C string with explicit length into a Haskell string.+--+peekCStringLen           :: TextEncoding -> CStringLen -> IO String+peekCStringLen = peekEncodedCString++-- | Marshal a Haskell string into a NUL terminated C string.+--+-- * the Haskell string may /not/ contain any NUL characters+--+-- * new storage is allocated for the C string and must be+--   explicitly freed using 'Foreign.Marshal.Alloc.free' or+--   'Foreign.Marshal.Alloc.finalizerFree'.+--+newCString :: TextEncoding -> String -> IO CString+newCString enc = liftM fst . newEncodedCString enc True++-- | Marshal a Haskell string into a C string (ie, character array) with+-- explicit length information.+--+-- * new storage is allocated for the C string and must be+--   explicitly freed using 'Foreign.Marshal.Alloc.free' or+--   'Foreign.Marshal.Alloc.finalizerFree'.+--+newCStringLen     :: TextEncoding -> String -> IO CStringLen+newCStringLen enc = newEncodedCString enc False++-- | Marshal a Haskell string into a NUL terminated C string using temporary+-- storage.+--+-- * the Haskell string may /not/ contain any NUL characters+--+-- * the memory is freed when the subcomputation terminates (either+--   normally or via an exception), so the pointer to the temporary+--   storage must /not/ be used after this.+--+withCString :: TextEncoding -> String -> (CString -> IO a) -> IO a+withCString enc s act = withEncodedCString enc True s $ \(cp, _sz) -> act cp++-- | Marshal a Haskell string into a C string (ie, character array)+-- in temporary storage, with explicit length information.+--+-- * the memory is freed when the subcomputation terminates (either+--   normally or via an exception), so the pointer to the temporary+--   storage must /not/ be used after this.+--+withCStringLen         :: TextEncoding -> String -> (CStringLen -> IO a) -> IO a+withCStringLen enc = withEncodedCString enc False+++-- | Determines whether a character can be accurately encoded in a 'CString'.+--+-- Pretty much anyone who uses this function is in a state of sin because+-- whether or not a character is encodable will, in general, depend on the+-- context in which it occurs.+charIsRepresentable :: TextEncoding -> Char -> IO Bool+charIsRepresentable enc c = withCString enc [c] (fmap (== [c]) . peekCString enc) `catchException` (\e -> let _ = e :: IOException in return False)++-- auxiliary definitions+-- ----------------------++-- C's end of string character+nUL :: CChar+nUL  = 0++-- Size of a CChar in bytes+cCharSize :: Int+cCharSize = sizeOf (undefined :: CChar)+++{-# INLINE peekEncodedCString #-}+peekEncodedCString :: TextEncoding -- ^ Encoding of CString+                   -> CStringLen+                   -> IO String    -- ^ String in Haskell terms+peekEncodedCString (TextEncoding { mkTextDecoder = mk_decoder }) (p, sz_bytes)+  = bracket mk_decoder close $ \decoder -> do+      let chunk_size = sz_bytes `max` 1 -- Decode buffer chunk size in characters: one iteration only for ASCII+      from0 <- fmap (\fp -> bufferAdd sz_bytes (emptyBuffer fp sz_bytes ReadBuffer)) $ newForeignPtr_ (castPtr p)+      to <- newCharBuffer chunk_size WriteBuffer++      let go iteration from = do+            (why, from', to') <- encode decoder from to+            if isEmptyBuffer from'+             then+              -- No input remaining: @why@ will be InputUnderflow, but we don't care+              fmap (map desurrogatifyRoundtripCharacter) $ withBuffer to' $ peekArray (bufferElems to')+             else do+              -- Input remaining: what went wrong?+              putDebugMsg ("peekEncodedCString: " ++ show iteration ++ " " ++ show why)+              (from'', to'') <- case why of InvalidSequence -> recover decoder from' to' -- These conditions are equally bad because+                                            InputUnderflow  -> recover decoder from' to' -- they indicate malformed/truncated input+                                            OutputUnderflow -> return (from', to')       -- We will have more space next time round+              putDebugMsg ("peekEncodedCString: from " ++ summaryBuffer from ++ " " ++ summaryBuffer from' ++ " " ++ summaryBuffer from'')+              putDebugMsg ("peekEncodedCString: to " ++ summaryBuffer to ++ " " ++ summaryBuffer to' ++ " " ++ summaryBuffer to'')+              to_chars <- withBuffer to'' $ peekArray (bufferElems to'')+              fmap (map desurrogatifyRoundtripCharacter to_chars++) $ go (iteration + 1) from''++      go (0 :: Int) from0++{-# INLINE withEncodedCString #-}+withEncodedCString :: TextEncoding         -- ^ Encoding of CString to create+                   -> Bool                 -- ^ Null-terminate?+                   -> String               -- ^ String to encode+                   -> (CStringLen -> IO a) -- ^ Worker that can safely use the allocated memory+                   -> IO a+withEncodedCString (TextEncoding { mkTextEncoder = mk_encoder }) null_terminate s act+  = bracket mk_encoder close $ \encoder -> withArrayLen (map surrogatifyRoundtripCharacter s) $ \sz p -> do+      from <- fmap (\fp -> bufferAdd sz (emptyBuffer fp sz ReadBuffer)) $ newForeignPtr_ p++      let go iteration to_sz_bytes = do+           putDebugMsg ("withEncodedCString: " ++ show iteration)+           allocaBytes to_sz_bytes $ \to_p -> do+            mb_res <- tryFillBufferAndCall encoder null_terminate from to_p to_sz_bytes act+            case mb_res of+              Nothing  -> go (iteration + 1) (to_sz_bytes * 2)+              Just res -> return res++      -- If the input string is ASCII, this value will ensure we only allocate once+      go (0 :: Int) (cCharSize * (sz + 1))++{-# INLINE newEncodedCString #-}+newEncodedCString :: TextEncoding  -- ^ Encoding of CString to create+                  -> Bool          -- ^ Null-terminate?+                  -> String        -- ^ String to encode+                  -> IO CStringLen+newEncodedCString (TextEncoding { mkTextEncoder = mk_encoder }) null_terminate s+  = bracket mk_encoder close $ \encoder -> withArrayLen (map surrogatifyRoundtripCharacter s) $ \sz p -> do+      from <- fmap (\fp -> bufferAdd sz (emptyBuffer fp sz ReadBuffer)) $ newForeignPtr_ p++      let go iteration to_p to_sz_bytes = do+           putDebugMsg ("newEncodedCString: " ++ show iteration)+           mb_res <- tryFillBufferAndCall encoder null_terminate from to_p to_sz_bytes return+           case mb_res of+             Nothing  -> do+                 let to_sz_bytes' = to_sz_bytes * 2+                 to_p' <- reallocBytes to_p to_sz_bytes'+                 go (iteration + 1) to_p' to_sz_bytes'+             Just res -> return res++      -- If the input string is ASCII, this value will ensure we only allocate once+      let to_sz_bytes = cCharSize * (sz + 1)+      to_p <- mallocBytes to_sz_bytes+      go (0 :: Int) to_p to_sz_bytes+++tryFillBufferAndCall :: TextEncoder dstate -> Bool -> Buffer Char -> Ptr Word8 -> Int+                     -> (CStringLen -> IO a) -> IO (Maybe a)+tryFillBufferAndCall encoder null_terminate from0 to_p to_sz_bytes act = do+    to_fp <- newForeignPtr_ to_p+    go (0 :: Int) (from0, emptyBuffer to_fp to_sz_bytes WriteBuffer)+  where+    go iteration (from, to) = do+      (why, from', to') <- encode encoder from to+      putDebugMsg ("tryFillBufferAndCall: " ++ show iteration ++ " " ++ show why ++ " " ++ summaryBuffer from ++ " " ++ summaryBuffer from')+      if isEmptyBuffer from'+       then if null_terminate && bufferAvailable to' == 0+             then return Nothing -- We had enough for the string but not the terminator: ask the caller for more buffer+             else do+               -- Awesome, we had enough buffer+               let bytes = bufferElems to'+               withBuffer to' $ \to_ptr -> do+                   when null_terminate $ pokeElemOff to_ptr (bufR to') 0+                   fmap Just $ act (castPtr to_ptr, bytes) -- NB: the length information is specified as being in *bytes*+       else case why of -- We didn't consume all of the input+              InputUnderflow  -> recover encoder from' to' >>= go (iteration + 1) -- These conditions are equally bad+              InvalidSequence -> recover encoder from' to' >>= go (iteration + 1) -- since the input was truncated/invalid+              OutputUnderflow -> return Nothing -- Oops, out of buffer during decoding: ask the caller for more
GHC/ForeignPtr.hs view
@@ -1,5 +1,12 @@-{-# OPTIONS_GHC -XNoImplicitPrelude #-}+{-# LANGUAGE CPP+           , NoImplicitPrelude+           , BangPatterns+           , MagicHash+           , UnboxedTuples+  #-} {-# OPTIONS_HADDOCK hide #-}+{-# LANGUAGE DeriveDataTypeable, StandaloneDeriving #-}+ ----------------------------------------------------------------------------- -- | -- Module      :  GHC.ForeignPtr
GHC/Handle.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE Trustworthy #-} {-# OPTIONS_HADDOCK hide #-} ----------------------------------------------------------------------------- -- |@@ -53,3 +54,4 @@ import GHC.IO.Handle import GHC.IO.Handle.Internals import GHC.IO.Handle.FD+
GHC/IO.hs view
@@ -1,5 +1,10 @@+{-# LANGUAGE NoImplicitPrelude+           , BangPatterns+           , RankNTypes+           , MagicHash+           , UnboxedTuples+  #-} {-# OPTIONS_GHC -funbox-strict-fields #-}-{-# LANGUAGE NoImplicitPrelude, BangPatterns, RankNTypes #-} {-# OPTIONS_HADDOCK hide #-} ----------------------------------------------------------------------------- -- |@@ -17,22 +22,22 @@  -- #hide module GHC.IO (-    IO(..), unIO, failIO, liftIO,-    unsafePerformIO, unsafeInterleaveIO,-    unsafeDupablePerformIO, unsafeDupableInterleaveIO,-    noDuplicate,+        IO(..), unIO, failIO, liftIO,+        unsafePerformIO, unsafeInterleaveIO,+        unsafeDupablePerformIO, unsafeDupableInterleaveIO,+        noDuplicate,          -- To and from from ST-    stToIO, ioToST, unsafeIOToST, unsafeSTToIO,+        stToIO, ioToST, unsafeIOToST, unsafeSTToIO, -    FilePath,+        FilePath, -    catchException, catchAny, throwIO,-    mask, mask_, uninterruptibleMask, uninterruptibleMask_, -    MaskingState(..), getMaskingState,-    block, unblock, blocked, unsafeUnmask,-    onException, finally, evaluate-  ) where+        catchException, catchAny, throwIO,+        mask, mask_, uninterruptibleMask, uninterruptibleMask_, +        MaskingState(..), getMaskingState,+        block, unblock, blocked, unsafeUnmask,+        onException, bracket, finally, evaluate+    ) where  import GHC.Base import GHC.ST@@ -159,9 +164,9 @@ unsafePerformIO m = unsafeDupablePerformIO (noDuplicate >> m)  {-| -This version of 'unsafePerformIO' is slightly more efficient,+This version of 'unsafePerformIO' is more efficient because it omits the check that the IO is only being performed by a-single thread.  Hence, when you write 'unsafeDupablePerformIO',+single thread.  Hence, when you use '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.@@ -254,7 +259,7 @@ catchException (IO io) handler = IO $ catch# io handler'     where handler' e = case fromException e of                        Just e' -> unIO (handler e')-                       Nothing -> raise# e+                       Nothing -> raiseIO# e  catchAny :: IO a -> (forall e . Exception e => e -> IO a) -> IO a catchAny (IO io) handler = IO $ catch# io handler'@@ -337,6 +342,7 @@                              1# -> MaskedUninterruptible                              _  -> MaskedInterruptible #) +{-# DEPRECATED blocked "use Control.Exception.getMaskingState instead" #-} -- | returns True if asynchronous exceptions are blocked in the -- current thread. blocked :: IO Bool@@ -344,7 +350,7 @@  onException :: IO a -> IO b -> IO a onException io what = io `catchException` \e -> do _ <- what-                                                   throw (e :: SomeException)+                                                   throwIO (e :: SomeException)  -- | Executes an IO computation with asynchronous -- exceptions /masked/.  That is, any thread which attempts to raise@@ -426,6 +432,18 @@     MaskedInterruptible   -> blockUninterruptible $ io block     MaskedUninterruptible -> io id +bracket+        :: IO a         -- ^ computation to run first (\"acquire resource\")+        -> (a -> IO b)  -- ^ computation to run last (\"release resource\")+        -> (a -> IO c)  -- ^ computation to run in-between+        -> IO c         -- returns the value from the in-between computation+bracket before after thing =+  mask $ \restore -> do+    a <- before+    r <- restore (thing a) `onException` after a+    _ <- after a+    return r+ finally :: IO a         -- ^ computation to run first         -> IO b         -- ^ computation to run afterward (even if an exception                         -- was raised)@@ -451,4 +469,4 @@ -- >   evaluate x = (return $! x) >>= return -- evaluate :: a -> IO a-evaluate a = IO $ \s -> let !va = a in (# s, va #) -- NB. see #2273+evaluate a = IO $ \s -> seq# a s -- NB. see #2273, #5129
GHC/IO.hs-boot view
@@ -1,3 +1,5 @@+{-# LANGUAGE NoImplicitPrelude #-}+ module GHC.IO where  import GHC.Types
GHC/IO/Buffer.hs view
@@ -1,4 +1,7 @@-{-# OPTIONS_GHC  -XNoImplicitPrelude -funbox-strict-fields #-}+{-# LANGUAGE Trustworthy #-}+{-# LANGUAGE CPP, NoImplicitPrelude, ForeignFunctionInterface #-}+{-# OPTIONS_GHC -funbox-strict-fields #-}+ ----------------------------------------------------------------------------- -- | -- Module      :  GHC.IO.Buffer
GHC/IO/BufferedIO.hs view
@@ -1,4 +1,7 @@-{-# OPTIONS_GHC  -XNoImplicitPrelude -funbox-strict-fields #-}+{-# LANGUAGE Trustworthy #-}+{-# LANGUAGE NoImplicitPrelude #-}+{-# OPTIONS_GHC -funbox-strict-fields #-}+ ----------------------------------------------------------------------------- -- | -- Module      :  GHC.IO.BufferedIO@@ -14,16 +17,15 @@ -----------------------------------------------------------------------------  module GHC.IO.BufferedIO (-   BufferedIO(..),-   readBuf, readBufNonBlocking, writeBuf, writeBufNonBlocking- ) where+        BufferedIO(..),+        readBuf, readBufNonBlocking, writeBuf, writeBufNonBlocking+    ) where  import GHC.Base import GHC.Ptr import Data.Word import GHC.Num import Data.Maybe--- import GHC.IO import GHC.IO.Device as IODevice import GHC.IO.Device as RawIO import GHC.IO.Buffer
GHC/IO/Device.hs view
@@ -1,4 +1,6 @@-{-# OPTIONS_GHC -XNoImplicitPrelude -XBangPatterns #-}+{-# LANGUAGE Trustworthy #-}+{-# LANGUAGE CPP, NoImplicitPrelude, BangPatterns #-}+ ----------------------------------------------------------------------------- -- | -- Module      :  GHC.IO.Device@@ -14,11 +16,11 @@ -----------------------------------------------------------------------------  module GHC.IO.Device (-    RawIO(..),-    IODevice(..),-    IODeviceType(..),-    SeekMode(..)-  ) where  +        RawIO(..),+        IODevice(..),+        IODeviceType(..),+        SeekMode(..)+    ) where    #ifdef __GLASGOW_HASKELL__ import GHC.Base
GHC/IO/Encoding.hs view
@@ -1,4 +1,7 @@-{-# OPTIONS_GHC -XNoImplicitPrelude -funbox-strict-fields #-}+{-# LANGUAGE Trustworthy #-}+{-# LANGUAGE CPP, NoImplicitPrelude, PatternGuards #-}+{-# OPTIONS_GHC -funbox-strict-fields #-}+ ----------------------------------------------------------------------------- -- | -- Module      :  GHC.IO.Encoding@@ -14,18 +17,20 @@ -----------------------------------------------------------------------------  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+        BufferCodec(..), TextEncoding(..), TextEncoder, TextDecoder, CodingProgress(..),+        latin1, latin1_encode, latin1_decode,+        utf8, utf8_bom,+        utf16, utf16le, utf16be,+        utf32, utf32le, utf32be, +        localeEncoding, fileSystemEncoding, foreignEncoding,+        char8,+        mkTextEncoding,+    ) where  import GHC.Base---import GHC.IO+import GHC.IO.Exception import GHC.IO.Buffer+import GHC.IO.Encoding.Failure import GHC.IO.Encoding.Types import GHC.Word #if !defined(mingw32_HOST_OS)@@ -39,10 +44,8 @@ import qualified GHC.IO.Encoding.UTF16  as UTF16 import qualified GHC.IO.Encoding.UTF32  as UTF32 -#if defined(mingw32_HOST_OS)+import Data.List import Data.Maybe-import GHC.IO.Exception-#endif  -- ----------------------------------------------------------------------------- @@ -95,13 +98,44 @@ utf32be = UTF32.utf32be  -- | The Unicode encoding of the current locale-localeEncoding  :: TextEncoding+localeEncoding :: TextEncoding++-- | The Unicode encoding of the current locale, but allowing arbitrary+-- undecodable bytes to be round-tripped through it.+--+-- This 'TextEncoding' is used to decode and encode command line arguments+-- and environment variables on non-Windows platforms.+--+-- On Windows, this encoding *should not* be used if possible because+-- the use of code pages is deprecated: Strings should be retrieved+-- via the "wide" W-family of UTF-16 APIs instead+fileSystemEncoding :: TextEncoding++-- | The Unicode encoding of the current locale, but where undecodable+-- bytes are replaced with their closest visual match. Used for+-- the 'CString' marshalling functions in "Foreign.C.String"+foreignEncoding :: TextEncoding+ #if !defined(mingw32_HOST_OS) localeEncoding = Iconv.localeEncoding+fileSystemEncoding = Iconv.mkLocaleEncoding RoundtripFailure+foreignEncoding = Iconv.mkLocaleEncoding IgnoreCodingFailure #else localeEncoding = CodePage.localeEncoding+fileSystemEncoding = CodePage.mkLocaleEncoding RoundtripFailure+foreignEncoding = CodePage.mkLocaleEncoding IgnoreCodingFailure #endif +-- | An encoding in which Unicode code points are translated to bytes+-- by taking the code point modulo 256.  When decoding, bytes are+-- translated directly into the equivalent code point.+--+-- This encoding never fails in either direction.  However, encoding+-- discards information, so encode followed by decode is not the+-- identity.+char8 :: TextEncoding+char8 = Latin1.latin1+ -- | Look up the named Unicode encoding.  May fail with  -- --  * 'isDoesNotExistError' if the encoding is unknown@@ -129,27 +163,40 @@ -- @CP@; for example, @\"CP1250\"@. -- mkTextEncoding :: String -> IO TextEncoding-#if !defined(mingw32_HOST_OS)-mkTextEncoding = Iconv.mkTextEncoding+mkTextEncoding e = case mb_coding_failure_mode of+  Nothing -> unknown_encoding+  Just cfm -> case enc of+    "UTF-8"    -> return $ UTF8.mkUTF8 cfm+    "UTF-16"   -> return $ UTF16.mkUTF16 cfm+    "UTF-16LE" -> return $ UTF16.mkUTF16le cfm+    "UTF-16BE" -> return $ UTF16.mkUTF16be cfm+    "UTF-32"   -> return $ UTF32.mkUTF32 cfm+    "UTF-32LE" -> return $ UTF32.mkUTF32le cfm+    "UTF-32BE" -> return $ UTF32.mkUTF32be cfm+#if defined(mingw32_HOST_OS)+    'C':'P':n | [(cp,"")] <- reads n -> return $ CodePage.mkCodePageEncoding cfm cp+    _ -> unknown_encoding #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)+    _ -> Iconv.mkIconvEncoding cfm enc #endif+  where+    -- The only problem with actually documenting //IGNORE and //TRANSLIT as+    -- supported suffixes is that they are not necessarily supported with non-GNU iconv+    (enc, suffix) = span (/= '/') e+    mb_coding_failure_mode = case suffix of+        ""            -> Just ErrorOnCodingFailure+        "//IGNORE"    -> Just IgnoreCodingFailure+        "//TRANSLIT"  -> Just TransliterateCodingFailure+        "//ROUNDTRIP" -> Just RoundtripFailure+        _             -> Nothing+    +    unknown_encoding = ioException (IOError Nothing NoSuchThing "mkTextEncoding"+                                            ("unknown encoding:" ++ e)  Nothing Nothing)  latin1_encode :: CharBuffer -> Buffer Word8 -> IO (CharBuffer, Buffer Word8)-latin1_encode = Latin1.latin1_encode -- unchecked, used for binary+latin1_encode input output = fmap (\(_why,input',output') -> (input',output')) $ Latin1.latin1_encode input output -- unchecked, used for char8 --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 input output = fmap (\(_why,input',output') -> (input',output')) $ Latin1.latin1_decode input output --latin1_decode = unsafePerformIO $ do mkTextDecoder Iconv.latin1 >>= return.encode
+ GHC/IO/Encoding.hs-boot view
@@ -0,0 +1,7 @@+{-# LANGUAGE Trustworthy #-}+{-# LANGUAGE NoImplicitPrelude #-}+module GHC.IO.Encoding where++import GHC.IO.Encoding.Types++localeEncoding, fileSystemEncoding, foreignEncoding :: TextEncoding
GHC/IO/Encoding/CodePage.hs view
@@ -1,10 +1,12 @@-{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE Trustworthy #-}+{-# LANGUAGE CPP, BangPatterns, ForeignFunctionInterface, NoImplicitPrelude,+             NondecreasingIndentation, MagicHash #-} module GHC.IO.Encoding.CodePage( #if !defined(mingw32_HOST_OS)  ) where #else-                        codePageEncoding,-                        localeEncoding+                        codePageEncoding, mkCodePageEncoding,+                        localeEncoding, mkLocaleEncoding                             ) where  import GHC.Base@@ -13,19 +15,19 @@ import GHC.Enum import GHC.Word import GHC.IO (unsafePerformIO)+import GHC.IO.Encoding.Failure 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)+import GHC.IO.Encoding.Latin1 (mkLatin1)+import GHC.IO.Encoding.UTF8 (mkUTF8)+import GHC.IO.Encoding.UTF16 (mkUTF16le, mkUTF16be)+import GHC.IO.Encoding.UTF32 (mkUTF32le, mkUTF32be)  -- note CodePage = UInt which might not work on Win64.  But the Win32 package -- also has this issue.@@ -43,43 +45,59 @@ foreign import stdcall unsafe "windows.h GetACP"     getACP :: IO Word32 -{-# NOINLINE localeEncoding #-}+{-# NOINLINE currentCodePage #-}+currentCodePage :: Word32+currentCodePage = unsafePerformIO getCurrentCodePage+ localeEncoding :: TextEncoding-localeEncoding = unsafePerformIO $ fmap codePageEncoding getCurrentCodePage-    +localeEncoding = mkLocaleEncoding ErrorOnCodingFailure +mkLocaleEncoding :: CodingFailureMode -> TextEncoding+mkLocaleEncoding cfm = mkCodePageEncoding cfm currentCodePage++ codePageEncoding :: Word32 -> TextEncoding-codePageEncoding 65001 = utf8-codePageEncoding 1200 = utf16le-codePageEncoding 1201 = utf16be-codePageEncoding 12000 = utf32le-codePageEncoding 12001 = utf32be-codePageEncoding cp = maybe latin1 (buildEncoding cp) (lookup cp codePageMap)+codePageEncoding = mkCodePageEncoding ErrorOnCodingFailure -buildEncoding :: Word32 -> CodePageArrays -> TextEncoding-buildEncoding cp SingleByteCP {decoderArray = dec, encoderArray = enc}+mkCodePageEncoding :: CodingFailureMode -> Word32 -> TextEncoding+mkCodePageEncoding cfm 65001 = mkUTF8 cfm+mkCodePageEncoding cfm 1200 = mkUTF16le cfm+mkCodePageEncoding cfm 1201 = mkUTF16be cfm+mkCodePageEncoding cfm 12000 = mkUTF32le cfm+mkCodePageEncoding cfm 12001 = mkUTF32be cfm+mkCodePageEncoding cfm cp = maybe (mkLatin1 cfm) (buildEncoding cfm cp) (lookup cp codePageMap)++buildEncoding :: CodingFailureMode -> Word32 -> CodePageArrays -> TextEncoding+buildEncoding cfm cp SingleByteCP {decoderArray = dec, encoderArray = enc}   = TextEncoding {-    textEncodingName = "CP" ++ show cp,-    mkTextDecoder = return $ simpleCodec-        $ decodeFromSingleByte dec-    , mkTextEncoder = return $ simpleCodec $ encodeToSingleByte enc+      textEncodingName = "CP" ++ show cp+    , mkTextDecoder = return $ simpleCodec (recoverDecode cfm) $ decodeFromSingleByte dec+    , mkTextEncoder = return $ simpleCodec (recoverEncode cfm) $ encodeToSingleByte enc     }  simpleCodec :: (Buffer from -> Buffer to -> IO (Buffer from, Buffer to))+            -> (Buffer from -> Buffer to -> IO (CodingProgress, Buffer from, Buffer to))                 -> BufferCodec from to ()-simpleCodec f = BufferCodec {encode = f, close = return (), getState = return (),-                                    setState = return }+simpleCodec r f = BufferCodec {+    encode = f,+    recover = r,+    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})+        done why !ir !ow = return (why,+                                   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+            | ow >= os  = done OutputUnderflow ir ow+            | ir >= iw  = done InputUnderflow ir ow             | otherwise = do                 b <- readWord8Buf iraw ir                 let c = lookupConv convArr b@@ -87,7 +105,7 @@                 ow' <- writeCharBuf oraw ow c                 loop (ir+1) ow'           where-            invalid = if ir > ir0 then done ir ow else ioe_decodingError+            invalid = done InvalidSequence ir ow     in loop ir0 ow0  encodeToSingleByte :: CompactArray Char Word8 -> EncodeBuffer@@ -97,11 +115,13 @@     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})+        done why !ir !ow = return (why,+                                   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+            | ow >= os  = done OutputUnderflow ir ow+            | ir >= iw  = done InputUnderflow ir ow             | otherwise = do                 (c,ir') <- readCharBuf iraw ir                 case lookupCompact maxChar indices values c of@@ -111,19 +131,9 @@                         writeWord8Buf oraw ow b                         loop ir' (ow+1)             where-                invalid = if ir > ir0 then done ir ow else ioe_encodingError+                invalid = done InvalidSequence ir ow     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)   --------------------------------------------
GHC/IO/Encoding/CodePage/Table.hs view
@@ -1,6 +1,9 @@-{-# LANGUAGE MagicHash #-}+{-# LANGUAGE CPP, MagicHash, NoImplicitPrelude #-} -- Do not edit this file directly!--- It was generated by the MakeTable.hs script using the following files:+-- It was generated by the MakeTable.hs script using the files below.+-- To regenerate it, run "make" in ../../../../codepages/+-- +-- Files: -- CP037.TXT -- CP1026.TXT -- CP1250.TXT@@ -35,7 +38,6 @@ import GHC.Prim import GHC.Base import GHC.Word-import GHC.Num data ConvArray a = ConvArray Addr# data CompactArray a b = CompactArray {     encoderMax :: !a,
+ GHC/IO/Encoding/Failure.hs view
@@ -0,0 +1,174 @@+{-# LANGUAGE Trustworthy #-}+{-# LANGUAGE NoImplicitPrelude, PatternGuards #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  GHC.IO.Encoding.Failure+-- Copyright   :  (c) The University of Glasgow, 2008-2011+-- License     :  see libraries/base/LICENSE+-- +-- Maintainer  :  libraries@haskell.org+-- Stability   :  internal+-- Portability :  non-portable+--+-- Types for specifying how text encoding/decoding fails+--+-----------------------------------------------------------------------------++module GHC.IO.Encoding.Failure (+    CodingFailureMode(..), codingFailureModeSuffix,+    isSurrogate,+    surrogatifyRoundtripCharacter, desurrogatifyRoundtripCharacter,+    recoverDecode, recoverEncode+  ) where++import GHC.IO+import GHC.IO.Buffer+import GHC.IO.Exception++import GHC.Base+import GHC.Word+import GHC.Show+import GHC.Num+import GHC.Real ( fromIntegral )++--import System.Posix.Internals++import Data.Maybe++-- | The 'CodingFailureMode' is used to construct 'TextEncoding's, and specifies+-- how they handle illegal sequences.+data CodingFailureMode = ErrorOnCodingFailure         -- ^ Throw an error when an illegal sequence is encountered+                       | IgnoreCodingFailure          -- ^ Attempt to ignore and recover if an illegal sequence is encountered+                       | TransliterateCodingFailure   -- ^ Replace with the closest visual match upon an illegal sequence+                       | RoundtripFailure             -- ^ Use the private-use escape mechanism to attempt to allow illegal sequences to be roundtripped.+                       deriving (Show)                -- This will only work properly for those encodings which are strict supersets of ASCII in the sense+                                                      -- that valid ASCII data is also valid in that encoding. This is not true for e.g. UTF-16, because+                                                      -- ASCII characters must be padded to two bytes to retain their meaning.++-- Note [Roundtripping]+-- ~~~~~~~~~~~~~~~~~~~~+--+-- Roundtripping is based on the ideas of PEP383. However, unlike PEP383 we do not wish to use lone surrogate codepoints+-- to escape undecodable bytes, because that may confuse Unicode processing software written in Haskell. Instead, we use+-- the range of private-use characters from 0xEF80 to 0xEFFF designated for "encoding hacks" by the ConScript Unicode Registery.+--+-- This introduces a technical problem when it comes to encoding back to bytes using iconv. The iconv code will not fail when+-- it tries to encode a private-use character (as it would if trying to encode a surrogate), which means that we won't get a+-- chance to replace it with the byte we originally escaped.+--+-- To work around this, when filling the buffer to be encoded (in writeBlocks/withEncodedCString/newEncodedCString), we replace+-- the private-use characters with lone surrogates again! Likewise, when reading from a buffer (unpack/unpack_nl/peekEncodedCString)+-- we have to do the inverse process.+--+-- The user of String should never see these lone surrogates, but it ensures that iconv will throw an error when encountering them.+-- We use lone surrogates in the range 0xDC00 to 0xDCFF for this purpose.++codingFailureModeSuffix :: CodingFailureMode -> String+codingFailureModeSuffix ErrorOnCodingFailure       = ""+codingFailureModeSuffix IgnoreCodingFailure        = "//IGNORE"+codingFailureModeSuffix TransliterateCodingFailure = "//TRANSLIT"+codingFailureModeSuffix RoundtripFailure           = "//ROUNDTRIP"++-- | In transliterate mode, we use this character when decoding unknown bytes.+--+-- This is the defined Unicode replacement character: <http://www.fileformat.info/info/unicode/char/0fffd/index.htm>+unrepresentableChar :: Char+unrepresentableChar = '\xFFFD'++-- | Some characters are actually "surrogate" codepoints defined for use in UTF-16. We need to signal an+-- invalid character if we detect them when encoding a sequence of 'Char's into 'Word8's because they won't+-- give valid Unicode.+--+-- We may also need to signal an invalid character if we detect them when encoding a sequence of 'Char's into 'Word8's+-- because the 'RoundtripFailure' mode creates these to round-trip bytes through our internal UTF-16 encoding.+isSurrogate :: Char -> Bool+isSurrogate c = (0xD800 <= x && x <= 0xDBFF) || (0xDC00 <= x && x <= 0xDFFF)+  where x = ord c++-- | We use some private-use characters for roundtripping unknown bytes through a String+isRoundtripEscapeChar :: Char -> Bool+isRoundtripEscapeChar c = 0xEF00 <= x && x < 0xF000+  where x = ord c++-- | We use some surrogate characters for roundtripping unknown bytes through a String+isRoundtripEscapeSurrogateChar :: Char -> Bool+isRoundtripEscapeSurrogateChar c = 0xDC00 <= x && x < 0xDD00+  where x = ord c++-- Private use characters (in Strings) --> lone surrogates (in Buffer CharBufElem)+surrogatifyRoundtripCharacter :: Char -> Char+surrogatifyRoundtripCharacter c | isRoundtripEscapeChar c = chr (ord c - 0xEF00 + 0xDC00)+                                | otherwise               = c++-- Lone surrogates (in Buffer CharBufElem) --> private use characters (in Strings)+desurrogatifyRoundtripCharacter :: Char -> Char+desurrogatifyRoundtripCharacter c | isRoundtripEscapeSurrogateChar c = chr (ord c - 0xDC00 + 0xEF00)+                                  | otherwise                        = c++-- Bytes (in Buffer Word8) --> lone surrogates (in Buffer CharBufElem)+escapeToRoundtripCharacterSurrogate :: Word8 -> Char+escapeToRoundtripCharacterSurrogate b+  | b < 128   = chr (fromIntegral b) -- Disallow 'smuggling' of ASCII bytes. For roundtripping to work, this assumes encoding is ASCII-superset.+  | otherwise = chr (0xDC00 + fromIntegral b)++-- Lone surrogates (in Buffer CharBufElem) --> bytes (in Buffer Word8)+unescapeRoundtripCharacterSurrogate :: Char -> Maybe Word8+unescapeRoundtripCharacterSurrogate c+    | 0xDC80 <= x && x < 0xDD00 = Just (fromIntegral x) -- Discard high byte+    | otherwise                 = Nothing+  where x = ord c++recoverDecode :: CodingFailureMode -> Buffer Word8 -> Buffer Char -> IO (Buffer Word8, Buffer Char)+recoverDecode cfm input@Buffer{  bufRaw=iraw, bufL=ir, bufR=_  }+                  output@Buffer{ bufRaw=oraw, bufL=_,  bufR=ow } = do+ --puts $ "recoverDecode " ++ show ir+ case cfm of+  ErrorOnCodingFailure       -> ioe_decodingError+  IgnoreCodingFailure        -> return (input { bufL=ir+1 }, output)+  TransliterateCodingFailure -> do+      ow' <- writeCharBuf oraw ow unrepresentableChar+      return (input { bufL=ir+1 }, output { bufR=ow' })+  RoundtripFailure           -> do+      b <- readWord8Buf iraw ir+      ow' <- writeCharBuf oraw ow (escapeToRoundtripCharacterSurrogate b)+      return (input { bufL=ir+1 }, output { bufR=ow' })++recoverEncode :: CodingFailureMode -> Buffer Char -> Buffer Word8 -> IO (Buffer Char, Buffer Word8)+recoverEncode cfm input@Buffer{  bufRaw=iraw, bufL=ir, bufR=_  }+                  output@Buffer{ bufRaw=oraw, bufL=_,  bufR=ow } = do+  (c,ir') <- readCharBuf iraw ir+  --puts $ "recoverEncode " ++ show ir ++ " " ++ show ir'+  case cfm of+    IgnoreCodingFailure        -> return (input { bufL=ir' }, output)+    TransliterateCodingFailure -> do+        if c == '?'+         then return (input { bufL=ir' }, output)+         else do+          -- XXX: evil hack! To implement transliteration, we just poke an+          -- ASCII ? into the input buffer and tell the caller to try and decode+          -- again. This is *probably* safe given current uses of TextEncoding.+          --+          -- The "if" test above ensures we skip if the encoding fails to deal with+          -- the ?, though this should never happen in practice as all encodings are+          -- in fact capable of reperesenting all ASCII characters.+          _ir' <- writeCharBuf iraw ir '?'+          return (input, output)+        +        -- This implementation does not work because e.g. UTF-16 requires 2 bytes to+        -- encode a simple ASCII value+        --writeWord8Buf oraw ow unrepresentableByte+        --return (input { bufL=ir' }, output { bufR=ow+1 })+    RoundtripFailure | Just x <- unescapeRoundtripCharacterSurrogate c -> do+        writeWord8Buf oraw ow x+        return (input { bufL=ir' }, output { bufR=ow+1 })+    _                          -> ioe_encodingError++ioe_decodingError :: IO a+ioe_decodingError = ioException+    (IOError Nothing InvalidArgument "recoverDecode"+        "invalid byte sequence" Nothing Nothing)++ioe_encodingError :: IO a+ioe_encodingError = ioException+    (IOError Nothing InvalidArgument "recoverEncode"+        "invalid character" Nothing Nothing)
GHC/IO/Encoding/Iconv.hs view
@@ -1,4 +1,10 @@-{-# OPTIONS_GHC -XNoImplicitPrelude #-}+{-# LANGUAGE Trustworthy #-}+{-# LANGUAGE CPP+           , NoImplicitPrelude+           , ForeignFunctionInterface+           , NondecreasingIndentation+  #-}+ ----------------------------------------------------------------------------- -- | -- Module      :  GHC.IO.Encoding.Iconv@@ -16,12 +22,8 @@ -- #hide module GHC.IO.Encoding.Iconv ( #if !defined(mingw32_HOST_OS)-   mkTextEncoding,-   latin1,-   utf8, -   utf16, utf16le, utf16be,-   utf32, utf32le, utf32be,-   localeEncoding+   iconvEncoding, mkIconvEncoding,+   localeEncoding, mkLocaleEncoding #endif  ) where @@ -30,12 +32,14 @@  #if !defined(mingw32_HOST_OS) -import Foreign hiding (unsafePerformIO)+import Foreign.Safe import Foreign.C import Data.Maybe import GHC.Base import GHC.IO.Buffer+import GHC.IO.Encoding.Failure import GHC.IO.Encoding.Types+import GHC.List (span) import GHC.Num import GHC.Show import GHC.Real@@ -50,55 +54,23 @@  | c_DEBUG_DUMP = puts s  | otherwise    = return () -puts :: String -> IO ()-puts s = do _ <- withCStringLen (s ++ "\n") $ \(p, len) ->-                     c_write 1 (castPtr p) (fromIntegral len)-            return ()- -- ----------------------------------------------------------------------------- -- 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+{-# NOINLINE localeEncodingName #-}+localeEncodingName :: String+localeEncodingName = unsafePerformIO $ do    -- Use locale_charset() or nl_langinfo(CODESET) to get the encoding    -- if we have either of them.    cstr <- c_localeEncoding-   r <- peekCString cstr-   mkTextEncoding r+   peekCAString cstr -- Assume charset names are ASCII +localeEncoding :: TextEncoding+localeEncoding = mkLocaleEncoding ErrorOnCodingFailure++mkLocaleEncoding :: CodingFailureMode -> TextEncoding+mkLocaleEncoding cfm = unsafePerformIO $ mkIconvEncoding cfm localeEncodingName+ -- 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)@@ -129,39 +101,47 @@ char_shift | charSize == 2 = 1            | otherwise     = 2 -mkTextEncoding :: String -> IO TextEncoding-mkTextEncoding charset = do+iconvEncoding :: String -> IO TextEncoding+iconvEncoding = mkIconvEncoding ErrorOnCodingFailure++mkIconvEncoding :: CodingFailureMode -> String -> IO TextEncoding+mkIconvEncoding cfm charset = do   return (TextEncoding {                  textEncodingName = charset,-		mkTextDecoder = newIConv charset haskellChar iconvDecode,-		mkTextEncoder = newIConv haskellChar charset iconvEncode})+		mkTextDecoder = newIConv raw_charset (haskellChar ++ suffix) (recoverDecode cfm) iconvDecode,+		mkTextEncoder = newIConv haskellChar charset                 (recoverEncode cfm) iconvEncode})+  where+    -- An annoying feature of GNU iconv is that the //PREFIXES only take+    -- effect when they appear on the tocode parameter to iconv_open:+    (raw_charset, suffix) = span (/= '/') charset  newIConv :: String -> String-   -> (IConv -> Buffer a -> Buffer b -> IO (Buffer a, Buffer b))+   -> (Buffer a -> Buffer b -> IO (Buffer a, Buffer b))+   -> (IConv -> Buffer a -> Buffer b -> IO (CodingProgress, Buffer a, Buffer b))    -> IO (BufferCodec a b ())-newIConv from to fn =-  withCString from $ \ from_str ->-  withCString to   $ \ to_str -> do+newIConv from to rec fn =+  -- Assume charset names are ASCII+  withCAString from $ \ from_str ->+  withCAString 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,+                recover = rec,                 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 -> DecodeBuffer 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 -> EncodeBuffer 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)+            -> IO (CodingProgress, 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@@ -190,29 +170,23 @@       iconv_trace ("iconvRecode after,  output=" ++ show (summaryBuffer new_output))       if (res /= -1) 	then do -- all input translated-	   return (new_input, new_output)+	   return (InputUnderflow, 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 harmless-                ---                -- 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)--        e -> do-                iconv_trace ("iconv returned error: " ++ show (errnoToIOError "iconv" e Nothing Nothing))-                throwErrno "iconvRecoder"-			-- illegal sequence, or some other error+        e | e == e2BIG  -> return (OutputUnderflow, new_input, new_output)+          | e == eINVAL -> return (InputUnderflow, new_input, new_output)+           -- 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.+           --+           -- Because we can only say InvalidSequence if there is at least+           -- one element left in the output, we have to special case this.+          | e == eILSEQ -> return (if new_outleft' == 0 then OutputUnderflow else InvalidSequence, new_input, new_output)+          | otherwise -> do+              iconv_trace ("iconv returned error: " ++ show (errnoToIOError "iconv" e Nothing Nothing))+              throwErrno "iconvRecoder"  #endif /* !mingw32_HOST_OS */
GHC/IO/Encoding/Latin1.hs view
@@ -1,5 +1,10 @@-{-# OPTIONS_GHC  -XNoImplicitPrelude -funbox-strict-fields #-}-{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE Trustworthy #-}+{-# LANGUAGE NoImplicitPrelude+           , BangPatterns+           , NondecreasingIndentation+  #-}+{-# OPTIONS_GHC  -funbox-strict-fields #-}+ ----------------------------------------------------------------------------- -- | -- Module      :  GHC.IO.Encoding.Latin1@@ -19,8 +24,8 @@ -----------------------------------------------------------------------------  module GHC.IO.Encoding.Latin1 (-  latin1,-  latin1_checked,+  latin1, mkLatin1,+  latin1_checked, mkLatin1_checked,   latin1_decode,   latin1_encode,   latin1_checked_encode,@@ -30,46 +35,54 @@ import GHC.Real import GHC.Num -- import GHC.IO-import GHC.IO.Exception import GHC.IO.Buffer+import GHC.IO.Encoding.Failure import GHC.IO.Encoding.Types-import Data.Maybe  -- ----------------------------------------------------------------------------- -- Latin1  latin1 :: TextEncoding-latin1 = TextEncoding { textEncodingName = "ISO8859-1",-                        mkTextDecoder = latin1_DF,-                        mkTextEncoder = latin1_EF }+latin1 = mkLatin1 ErrorOnCodingFailure -latin1_DF :: IO (TextDecoder ())-latin1_DF =+mkLatin1 :: CodingFailureMode -> TextEncoding+mkLatin1 cfm = TextEncoding { textEncodingName = "ISO8859-1",+                              mkTextDecoder = latin1_DF cfm,+                              mkTextEncoder = latin1_EF cfm }++latin1_DF :: CodingFailureMode -> IO (TextDecoder ())+latin1_DF cfm =   return (BufferCodec {              encode   = latin1_decode,+             recover  = recoverDecode cfm,              close    = return (),              getState = return (),              setState = const $ return ()           }) -latin1_EF :: IO (TextEncoder ())-latin1_EF =+latin1_EF :: CodingFailureMode -> IO (TextEncoder ())+latin1_EF cfm =   return (BufferCodec {              encode   = latin1_encode,+             recover  = recoverEncode cfm,              close    = return (),              getState = return (),              setState = const $ return ()           })  latin1_checked :: TextEncoding-latin1_checked = TextEncoding { textEncodingName = "ISO8859-1(checked)",-                                mkTextDecoder = latin1_DF,-                                mkTextEncoder = latin1_checked_EF }+latin1_checked = mkLatin1_checked ErrorOnCodingFailure -latin1_checked_EF :: IO (TextEncoder ())-latin1_checked_EF =+mkLatin1_checked :: CodingFailureMode -> TextEncoding+mkLatin1_checked cfm = TextEncoding { textEncodingName = "ISO8859-1(checked)",+                                      mkTextDecoder = latin1_DF cfm,+                                      mkTextEncoder = latin1_checked_EF cfm }++latin1_checked_EF :: CodingFailureMode -> IO (TextEncoder ())+latin1_checked_EF cfm =   return (BufferCodec {              encode   = latin1_checked_encode,+             recover  = recoverEncode cfm,              close    = return (),              getState = return (),              setState = const $ return ()@@ -82,16 +95,18 @@   output@Buffer{ bufRaw=oraw, bufL=_,   bufR=ow0, bufSize=os }  = let         loop !ir !ow-         | ow >= os || ir >= iw =  done ir ow+         | ow >= os = done OutputUnderflow ir ow+         | ir >= iw = done InputUnderflow 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 })+       done why !ir !ow = return (why,+                                  if ir == iw then input{ bufL=0, bufR=0 }+                                              else input{ bufL=ir },+                                  output{ bufR=ow })     in     loop ir0 ow0 @@ -100,11 +115,13 @@   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 })+      done why !ir !ow = return (why,+                                 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+        | ow >= os = done OutputUnderflow ir ow+        | ir >= iw = done InputUnderflow ir ow         | otherwise = do            (c,ir') <- readCharBuf iraw ir            writeWord8Buf oraw ow (fromIntegral (ord c))@@ -117,22 +134,19 @@   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 })+      done why !ir !ow = return (why,+                                 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+        | ow >= os = done OutputUnderflow ir ow+        | ir >= iw = done InputUnderflow 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+           invalid = done InvalidSequence ir ow     in     loop ir0 ow0--ioe_encodingError :: IO a-ioe_encodingError = ioException-     (IOError Nothing InvalidArgument "latin1_checked_encode"-          "character is out of range for this encoding" Nothing Nothing)
GHC/IO/Encoding/Types.hs view
@@ -1,4 +1,7 @@-{-# OPTIONS_GHC -XNoImplicitPrelude -funbox-strict-fields #-}+{-# LANGUAGE Trustworthy #-}+{-# LANGUAGE NoImplicitPrelude, ExistentialQuantification #-}+{-# OPTIONS_GHC -funbox-strict-fields #-}+ ----------------------------------------------------------------------------- -- | -- Module      :  GHC.IO.Encoding.Types@@ -18,6 +21,7 @@     TextEncoding(..),     TextEncoder, TextDecoder,     EncodeBuffer, DecodeBuffer,+    CodingProgress(..)   ) where  import GHC.Base@@ -30,22 +34,41 @@ -- Text encoders/decoders  data BufferCodec from to state = BufferCodec {-  encode :: Buffer from -> Buffer to -> IO (Buffer from, Buffer to),+  encode :: Buffer from -> Buffer to -> IO (CodingProgress, 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+   --+   -- The fact that as many elements as possible are translated 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.    --+   -- To allow us to use iconv as a BufferCode efficiently, character buffers are+   -- defined to contain lone surrogates instead of those private use characters that+   -- are used for roundtripping. Thus, Chars poked and peeked from a character buffer+   -- must undergo surrogatifyRoundtripCharacter and desurrogatifyRoundtripCharacter+   -- respectively.+   --+   -- For more information on this, see Note [Roundtripping] in GHC.IO.Encoding.Failure.+  +  recover :: Buffer from -> Buffer to -> IO (Buffer from, Buffer to),+   -- ^ The @recover@ function is used to continue decoding+   -- in the presence of invalid or unrepresentable sequences. This includes+   -- both those detected by @encode@ returning @InvalidSequence@ and those+   -- that occur because the input byte sequence appears to be truncated.+   --+   -- Progress will usually be made by skipping the first element of the @from@+   -- buffer. This function should only be called if you are certain that you+   -- wish to do this skipping, and if the @to@ buffer has at least one element+   -- of free space.+   --+   -- @recover@ may raise an exception rather than skipping anything.+   --+   -- Currently, some implementations of @recover@ may mutate the input buffer.+   -- In particular, this feature is used to implement transliteration.+     close  :: IO (),    -- ^ Resources associated with the encoding may now be released.    -- The @encode@ function may not be called again after calling@@ -64,16 +87,16 @@    -- beginning), and if not, whether to use the big or little-endian    -- encoding. -  setState :: state -> IO()+  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)+                  -> IO (CodingProgress, Buffer Word8, Buffer Char)  type EncodeBuffer = Buffer Char -> Buffer Word8-                  -> IO (Buffer Char, Buffer Word8)+                  -> IO (CodingProgress, Buffer Char, Buffer Word8)  type TextDecoder state = BufferCodec Word8 CharBufElem state type TextEncoder state = BufferCodec CharBufElem Word8 state@@ -88,10 +111,22 @@         textEncodingName :: String,                    -- ^ a string that can be passed to 'mkTextEncoding' to                    -- create an equivalent 'TextEncoding'.-	mkTextDecoder :: IO (TextDecoder dstate),-	mkTextEncoder :: IO (TextEncoder estate)+        mkTextDecoder :: IO (TextDecoder dstate),+                   -- ^ Creates a means of decoding bytes into characters: the result must not+                   -- be shared between several byte sequences or simultaneously across threads+        mkTextEncoder :: IO (TextEncoder estate)+                   -- ^ Creates a means of encode characters into bytes: the result must not+                   -- be shared between several character sequences or simultaneously across threads   }  instance Show TextEncoding where   -- | Returns the value of 'textEncodingName'   show te = textEncodingName te++data CodingProgress = InputUnderflow  -- ^ Stopped because the input contains insufficient available elements,+                                      -- or all of the input sequence has been sucessfully translated.+                    | OutputUnderflow -- ^ Stopped because the output contains insufficient free elements+                    | InvalidSequence -- ^ Stopped because there are sufficient free elements in the output+                                      -- to output at least one encoded ASCII character, but the input contains+                                      -- an invalid or unrepresentable sequence+                    deriving (Eq, Show)
GHC/IO/Encoding/UTF16.hs view
@@ -1,5 +1,12 @@-{-# OPTIONS_GHC  -XNoImplicitPrelude -funbox-strict-fields #-}-{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE Trustworthy #-}+{-# LANGUAGE CPP+           , NoImplicitPrelude+           , BangPatterns+           , NondecreasingIndentation+           , MagicHash+  #-}+{-# OPTIONS_GHC  -funbox-strict-fields #-}+ ----------------------------------------------------------------------------- -- | -- Module      :  GHC.IO.Encoding.UTF16@@ -19,15 +26,15 @@ -----------------------------------------------------------------------------  module GHC.IO.Encoding.UTF16 (-  utf16,+  utf16, mkUTF16,   utf16_decode,   utf16_encode, -  utf16be,+  utf16be, mkUTF16be,   utf16be_decode,   utf16be_encode, -  utf16le,+  utf16le, mkUTF16le,   utf16le_decode,   utf16le_encode,   ) where@@ -36,49 +43,42 @@ import GHC.Real import GHC.Num -- import GHC.IO-import GHC.IO.Exception import GHC.IO.Buffer+import GHC.IO.Encoding.Failure 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-import GHC.Ptr--puts :: String -> IO ()-puts s = do withCStringLen (s++"\n") $ \(p,len) -> -                c_write 1 (castPtr p) (fromIntegral len)-            return ()-#endif- -- ----------------------------------------------------------------------------- -- The UTF-16 codec: either UTF16BE or UTF16LE with a BOM  utf16  :: TextEncoding-utf16 = TextEncoding { textEncodingName = "UTF-16",-                       mkTextDecoder = utf16_DF,- 	               mkTextEncoder = utf16_EF }+utf16 = mkUTF16 ErrorOnCodingFailure -utf16_DF :: IO (TextDecoder (Maybe DecodeBuffer))-utf16_DF = do+mkUTF16 :: CodingFailureMode -> TextEncoding+mkUTF16 cfm =  TextEncoding { textEncodingName = "UTF-16",+                              mkTextDecoder = utf16_DF cfm,+                              mkTextEncoder = utf16_EF cfm }++utf16_DF :: CodingFailureMode -> IO (TextDecoder (Maybe DecodeBuffer))+utf16_DF cfm = do   seen_bom <- newIORef Nothing   return (BufferCodec {              encode   = utf16_decode seen_bom,+             recover  = recoverDecode cfm,              close    = return (),              getState = readIORef seen_bom,              setState = writeIORef seen_bom           }) -utf16_EF :: IO (TextEncoder Bool)-utf16_EF = do+utf16_EF :: CodingFailureMode -> IO (TextEncoder Bool)+utf16_EF cfm = do   done_bom <- newIORef False   return (BufferCodec {              encode   = utf16_encode done_bom,+             recover  = recoverEncode cfm,              close    = return (),              getState = readIORef done_bom,              setState = writeIORef done_bom@@ -91,7 +91,7 @@   b <- readIORef done_bom   if b then utf16_native_encode input output        else if os - ow < 2-               then return (input,output)+               then return (OutputUnderflow,input,output)                else do                     writeIORef done_bom True                     writeWord8Buf oraw ow     bom1@@ -107,7 +107,7 @@    case mb of      Just decode -> decode input output      Nothing ->-       if iw - ir < 2 then return (input,output) else do+       if iw - ir < 2 then return (InputUnderflow,input,output) else do        c0 <- readWord8Buf iraw ir        c1 <- readWord8Buf iraw (ir+1)        case () of@@ -140,46 +140,56 @@ -- UTF16LE and UTF16BE  utf16be :: TextEncoding-utf16be = TextEncoding { textEncodingName = "UTF-16BE",-                         mkTextDecoder = utf16be_DF,- 	                 mkTextEncoder = utf16be_EF }+utf16be = mkUTF16be ErrorOnCodingFailure -utf16be_DF :: IO (TextDecoder ())-utf16be_DF =+mkUTF16be :: CodingFailureMode -> TextEncoding+mkUTF16be cfm = TextEncoding { textEncodingName = "UTF-16BE",+                               mkTextDecoder = utf16be_DF cfm,+                               mkTextEncoder = utf16be_EF cfm }++utf16be_DF :: CodingFailureMode -> IO (TextDecoder ())+utf16be_DF cfm =   return (BufferCodec {              encode   = utf16be_decode,+             recover  = recoverDecode cfm,              close    = return (),              getState = return (),              setState = const $ return ()           }) -utf16be_EF :: IO (TextEncoder ())-utf16be_EF =+utf16be_EF :: CodingFailureMode -> IO (TextEncoder ())+utf16be_EF cfm =   return (BufferCodec {              encode   = utf16be_encode,+             recover  = recoverEncode cfm,              close    = return (),              getState = return (),              setState = const $ return ()           })  utf16le :: TextEncoding-utf16le = TextEncoding { textEncodingName = "UTF16-LE",-                         mkTextDecoder = utf16le_DF,- 	                 mkTextEncoder = utf16le_EF }+utf16le = mkUTF16le ErrorOnCodingFailure -utf16le_DF :: IO (TextDecoder ())-utf16le_DF =+mkUTF16le :: CodingFailureMode -> TextEncoding+mkUTF16le cfm = TextEncoding { textEncodingName = "UTF16-LE",+                               mkTextDecoder = utf16le_DF cfm,+                               mkTextEncoder = utf16le_EF cfm }++utf16le_DF :: CodingFailureMode -> IO (TextDecoder ())+utf16le_DF cfm =   return (BufferCodec {              encode   = utf16le_decode,+             recover  = recoverDecode cfm,              close    = return (),              getState = return (),              setState = const $ return ()           }) -utf16le_EF :: IO (TextEncoder ())-utf16le_EF =+utf16le_EF :: CodingFailureMode -> IO (TextEncoder ())+utf16le_EF cfm =   return (BufferCodec {              encode   = utf16le_encode,+             recover  = recoverEncode cfm,              close    = return (),              getState = return (),              setState = const $ return ()@@ -192,8 +202,9 @@   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+         | ow >= os     = done OutputUnderflow ir ow+         | ir >= iw     = done InputUnderflow ir ow+         | ir + 1 == iw = done InputUnderflow ir ow          | otherwise = do               c0 <- readWord8Buf iraw ir               c1 <- readWord8Buf iraw (ir+1)@@ -201,7 +212,7 @@               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+                 else if iw - ir < 4 then done InputUnderflow ir ow else do                       c2 <- readWord8Buf iraw (ir+2)                       c3 <- readWord8Buf iraw (ir+3)                       let x2 = fromIntegral c2 `shiftL` 8 + fromIntegral c3@@ -209,12 +220,13 @@                       ow' <- writeCharBuf oraw ow (chr2 x1 x2)                       loop (ir+4) ow'          where-           invalid = if ir > ir0 then done ir ow else ioe_decodingError+           invalid = done InvalidSequence ir 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 })+       done why !ir !ow = return (why,+                                  if ir == iw then input{ bufL=0, bufR=0 }+                                              else input{ bufL=ir },+                                  output{ bufR=ow })     in     loop ir0 ow0 @@ -224,8 +236,9 @@   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+         | ow >= os     = done OutputUnderflow ir ow+         | ir >= iw     = done InputUnderflow ir ow+         | ir + 1 == iw = done InputUnderflow ir ow          | otherwise = do               c0 <- readWord8Buf iraw ir               c1 <- readWord8Buf iraw (ir+1)@@ -233,7 +246,7 @@               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+                 else if iw - ir < 4 then done InputUnderflow ir ow else do                       c2 <- readWord8Buf iraw (ir+2)                       c3 <- readWord8Buf iraw (ir+3)                       let x2 = fromIntegral c3 `shiftL` 8 + fromIntegral c2@@ -241,40 +254,37 @@                       ow' <- writeCharBuf oraw ow (chr2 x1 x2)                       loop (ir+4) ow'          where-           invalid = if ir > ir0 then done ir ow else ioe_decodingError+           invalid = done InvalidSequence ir 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 })+       done why !ir !ow = return (why,+                                  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 })+      done why !ir !ow = return (why,+                                 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+        | ir >= iw     =  done InputUnderflow ir ow+        | os - ow < 2  =  done OutputUnderflow ir ow         | otherwise = do            (c,ir') <- readCharBuf iraw ir            case ord c of-             x | x < 0x10000 -> do+             x | x < 0x10000 -> if isSurrogate c then done InvalidSequence ir ow else 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+                    if os - ow < 4 then done OutputUnderflow ir ow else do                     let                           n1 = x - 0x10000                          c1 = fromIntegral (n1 `shiftR` 18 + 0xD8)@@ -296,21 +306,22 @@   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 })+      done why !ir !ow = return (why,+                                 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+        | ir >= iw     =  done InputUnderflow ir ow+        | os - ow < 2  =  done OutputUnderflow ir ow         | otherwise = do            (c,ir') <- readCharBuf iraw ir            case ord c of-             x | x < 0x10000 -> do+             x | x < 0x10000 -> if isSurrogate c then done InvalidSequence ir ow else 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+                    if os - ow < 4 then done OutputUnderflow ir ow else do                     let                           n1 = x - 0x10000                          c1 = fromIntegral (n1 `shiftR` 18 + 0xD8)
GHC/IO/Encoding/UTF32.hs view
@@ -1,5 +1,11 @@-{-# OPTIONS_GHC  -XNoImplicitPrelude -funbox-strict-fields #-}-{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE Trustworthy #-}+{-# LANGUAGE NoImplicitPrelude+           , BangPatterns+           , NondecreasingIndentation+           , MagicHash+  #-}+{-# OPTIONS_GHC  -funbox-strict-fields #-}+ ----------------------------------------------------------------------------- -- | -- Module      :  GHC.IO.Encoding.UTF32@@ -19,15 +25,15 @@ -----------------------------------------------------------------------------  module GHC.IO.Encoding.UTF32 (-  utf32,+  utf32, mkUTF32,   utf32_decode,   utf32_encode, -  utf32be,+  utf32be, mkUTF32be,   utf32be_decode,   utf32be_encode, -  utf32le,+  utf32le, mkUTF32le,   utf32le_decode,   utf32le_encode,   ) where@@ -36,8 +42,8 @@ import GHC.Real import GHC.Num -- import GHC.IO-import GHC.IO.Exception import GHC.IO.Buffer+import GHC.IO.Encoding.Failure import GHC.IO.Encoding.Types import GHC.Word import Data.Bits@@ -48,25 +54,30 @@ -- The UTF-32 codec: either UTF-32BE or UTF-32LE with a BOM  utf32  :: TextEncoding-utf32 = TextEncoding { textEncodingName = "UTF-32",-                       mkTextDecoder = utf32_DF,- 	               mkTextEncoder = utf32_EF }+utf32 = mkUTF32 ErrorOnCodingFailure -utf32_DF :: IO (TextDecoder (Maybe DecodeBuffer))-utf32_DF = do+mkUTF32 :: CodingFailureMode -> TextEncoding+mkUTF32 cfm = TextEncoding { textEncodingName = "UTF-32",+                             mkTextDecoder = utf32_DF cfm,+                             mkTextEncoder = utf32_EF cfm }++utf32_DF :: CodingFailureMode -> IO (TextDecoder (Maybe DecodeBuffer))+utf32_DF cfm = do   seen_bom <- newIORef Nothing   return (BufferCodec {              encode   = utf32_decode seen_bom,+             recover  = recoverDecode cfm,              close    = return (),              getState = readIORef seen_bom,              setState = writeIORef seen_bom           }) -utf32_EF :: IO (TextEncoder Bool)-utf32_EF = do+utf32_EF :: CodingFailureMode -> IO (TextEncoder Bool)+utf32_EF cfm = do   done_bom <- newIORef False   return (BufferCodec {              encode   = utf32_encode done_bom,+             recover  = recoverEncode cfm,              close    = return (),              getState = readIORef done_bom,              setState = writeIORef done_bom@@ -79,7 +90,7 @@   b <- readIORef done_bom   if b then utf32_native_encode input output        else if os - ow < 4-               then return (input,output)+               then return (OutputUnderflow, input,output)                else do                     writeIORef done_bom True                     writeWord8Buf oraw ow     bom0@@ -97,7 +108,7 @@    case mb of      Just decode -> decode input output      Nothing ->-       if iw - ir < 4 then return (input,output) else do+       if iw - ir < 4 then return (InputUnderflow, input,output) else do        c0 <- readWord8Buf iraw ir        c1 <- readWord8Buf iraw (ir+1)        c2 <- readWord8Buf iraw (ir+2)@@ -131,23 +142,28 @@ -- UTF32LE and UTF32BE  utf32be :: TextEncoding-utf32be = TextEncoding { textEncodingName = "UTF-32BE",-                         mkTextDecoder = utf32be_DF,- 	                 mkTextEncoder = utf32be_EF }+utf32be = mkUTF32be ErrorOnCodingFailure -utf32be_DF :: IO (TextDecoder ())-utf32be_DF =+mkUTF32be :: CodingFailureMode -> TextEncoding+mkUTF32be cfm = TextEncoding { textEncodingName = "UTF-32BE",+                               mkTextDecoder = utf32be_DF cfm,+                               mkTextEncoder = utf32be_EF cfm }++utf32be_DF :: CodingFailureMode -> IO (TextDecoder ())+utf32be_DF cfm =   return (BufferCodec {              encode   = utf32be_decode,+             recover  = recoverDecode cfm,              close    = return (),              getState = return (),              setState = const $ return ()           }) -utf32be_EF :: IO (TextEncoder ())-utf32be_EF =+utf32be_EF :: CodingFailureMode -> IO (TextEncoder ())+utf32be_EF cfm =   return (BufferCodec {              encode   = utf32be_encode,+             recover  = recoverEncode cfm,              close    = return (),              getState = return (),              setState = const $ return ()@@ -155,23 +171,28 @@   utf32le :: TextEncoding-utf32le = TextEncoding { textEncodingName = "UTF-32LE",-                         mkTextDecoder = utf32le_DF,- 	                 mkTextEncoder = utf32le_EF }+utf32le = mkUTF32le ErrorOnCodingFailure -utf32le_DF :: IO (TextDecoder ())-utf32le_DF =+mkUTF32le :: CodingFailureMode -> TextEncoding+mkUTF32le cfm = TextEncoding { textEncodingName = "UTF-32LE",+                               mkTextDecoder = utf32le_DF cfm,+                               mkTextEncoder = utf32le_EF cfm }++utf32le_DF :: CodingFailureMode -> IO (TextDecoder ())+utf32le_DF cfm =   return (BufferCodec {              encode   = utf32le_decode,+             recover  = recoverDecode cfm,              close    = return (),              getState = return (),              setState = const $ return ()           }) -utf32le_EF :: IO (TextEncoder ())-utf32le_EF =+utf32le_EF :: CodingFailureMode -> IO (TextEncoder ())+utf32le_EF cfm =   return (BufferCodec {              encode   = utf32le_encode,+             recover  = recoverEncode cfm,              close    = return (),              getState = return (),              setState = const $ return ()@@ -184,7 +205,8 @@   output@Buffer{ bufRaw=oraw, bufL=_,   bufR=ow0, bufSize=os }  = let         loop !ir !ow-         | ow >= os || iw - ir < 4 =  done ir ow+         | ow >= os    = done OutputUnderflow ir ow+         | iw - ir < 4 = done InputUnderflow  ir ow          | otherwise = do               c0 <- readWord8Buf iraw ir               c1 <- readWord8Buf iraw (ir+1)@@ -195,12 +217,13 @@               ow' <- writeCharBuf oraw ow x1               loop (ir+4) ow'          where-           invalid = if ir > ir0 then done ir ow else ioe_decodingError+           invalid = done InvalidSequence ir 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 })+       done why !ir !ow = return (why,+                                  if ir == iw then input{ bufL=0, bufR=0 }+                                              else input{ bufL=ir },+                                  output{ bufR=ow })     in     loop ir0 ow0 @@ -210,7 +233,8 @@   output@Buffer{ bufRaw=oraw, bufL=_,   bufR=ow0, bufSize=os }  = let         loop !ir !ow-         | ow >= os || iw - ir < 4 =  done ir ow+         | ow >= os    = done OutputUnderflow ir ow+         | iw - ir < 4 = done InputUnderflow  ir ow          | otherwise = do               c0 <- readWord8Buf iraw ir               c1 <- readWord8Buf iraw (ir+1)@@ -221,39 +245,37 @@               ow' <- writeCharBuf oraw ow x1               loop (ir+4) ow'          where-           invalid = if ir > ir0 then done ir ow else ioe_decodingError+           invalid = done InvalidSequence ir 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 })+       done why !ir !ow = return (why,+                                  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 })+      done why !ir !ow = return (why,+                                 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+        | ir >= iw    = done InputUnderflow  ir ow+        | os - ow < 4 = done OutputUnderflow 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)+           if isSurrogate c then done InvalidSequence ir ow else do+             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 @@ -262,20 +284,22 @@   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 })+      done why !ir !ow = return (why,+                                 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+        | ir >= iw    = done InputUnderflow  ir ow+        | os - ow < 4 = done OutputUnderflow 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)+           if isSurrogate c then done InvalidSequence ir ow else do+             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
GHC/IO/Encoding/UTF8.hs view
@@ -1,5 +1,11 @@-{-# OPTIONS_GHC  -XNoImplicitPrelude -funbox-strict-fields #-}-{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE Trustworthy #-}+{-# LANGUAGE NoImplicitPrelude+           , BangPatterns+           , NondecreasingIndentation+           , MagicHash+  #-}+{-# OPTIONS_GHC -funbox-strict-fields #-}+ ----------------------------------------------------------------------------- -- | -- Module      :  GHC.IO.Encoding.UTF8@@ -19,8 +25,8 @@ -----------------------------------------------------------------------------  module GHC.IO.Encoding.UTF8 (-  utf8,-  utf8_bom,+  utf8, mkUTF8,+  utf8_bom, mkUTF8_bom   ) where  import GHC.Base@@ -28,56 +34,66 @@ import GHC.Num import GHC.IORef -- import GHC.IO-import GHC.IO.Exception import GHC.IO.Buffer+import GHC.IO.Encoding.Failure import GHC.IO.Encoding.Types import GHC.Word import Data.Bits-import Data.Maybe  utf8 :: TextEncoding-utf8 = TextEncoding { textEncodingName = "UTF-8",-                      mkTextDecoder = utf8_DF,- 	              mkTextEncoder = utf8_EF }+utf8 = mkUTF8 ErrorOnCodingFailure -utf8_DF :: IO (TextDecoder ())-utf8_DF =+mkUTF8 :: CodingFailureMode -> TextEncoding+mkUTF8 cfm = TextEncoding { textEncodingName = "UTF-8",+                            mkTextDecoder = utf8_DF cfm,+                            mkTextEncoder = utf8_EF cfm }+++utf8_DF :: CodingFailureMode -> IO (TextDecoder ())+utf8_DF cfm =   return (BufferCodec {              encode   = utf8_decode,+             recover  = recoverDecode cfm,              close    = return (),              getState = return (),              setState = const $ return ()           }) -utf8_EF :: IO (TextEncoder ())-utf8_EF =+utf8_EF :: CodingFailureMode -> IO (TextEncoder ())+utf8_EF cfm =   return (BufferCodec {              encode   = utf8_encode,+             recover  = recoverEncode cfm,              close    = return (),              getState = return (),              setState = const $ return ()           })  utf8_bom :: TextEncoding-utf8_bom = TextEncoding { textEncodingName = "UTF-8BOM",-                          mkTextDecoder = utf8_bom_DF,-                          mkTextEncoder = utf8_bom_EF }+utf8_bom = mkUTF8_bom ErrorOnCodingFailure -utf8_bom_DF :: IO (TextDecoder Bool)-utf8_bom_DF = do+mkUTF8_bom :: CodingFailureMode -> TextEncoding+mkUTF8_bom cfm = TextEncoding { textEncodingName = "UTF-8BOM",+                                mkTextDecoder = utf8_bom_DF cfm,+                                mkTextEncoder = utf8_bom_EF cfm }++utf8_bom_DF :: CodingFailureMode -> IO (TextDecoder Bool)+utf8_bom_DF cfm = do    ref <- newIORef True    return (BufferCodec {              encode   = utf8_bom_decode ref,+             recover  = recoverDecode cfm,              close    = return (),              getState = readIORef ref,              setState = writeIORef ref           }) -utf8_bom_EF :: IO (TextEncoder Bool)-utf8_bom_EF = do+utf8_bom_EF :: CodingFailureMode -> IO (TextEncoder Bool)+utf8_bom_EF cfm = do    ref <- newIORef True    return (BufferCodec {              encode   = utf8_bom_encode ref,+             recover  = recoverEncode cfm,              close    = return (),              getState = readIORef ref,              setState = writeIORef ref@@ -93,13 +109,13 @@       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+       if iw - ir < 1 then return (InputUnderflow,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+       if iw - ir < 2 then return (InputUnderflow,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+       if iw - ir < 3 then return (InputUnderflow,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@@ -113,7 +129,7 @@   b <- readIORef ref   if not b then utf8_encode input output            else if os - ow < 3-                  then return (input,output)+                  then return (OutputUnderflow,input,output)                   else do                     writeIORef ref False                     writeWord8Buf oraw ow     bom0@@ -132,7 +148,8 @@   output@Buffer{ bufRaw=oraw, bufL=_,   bufR=ow0, bufSize=os }  = let         loop !ir !ow-         | ow >= os || ir >= iw = done ir ow+         | ow >= os = done OutputUnderflow ir ow+         | ir >= iw = done InputUnderflow ir ow          | otherwise = do               c0 <- readWord8Buf iraw ir               case c0 of@@ -140,19 +157,19 @@                            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+                           if iw - ir < 2 then done InputUnderflow 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+                        1 -> done InputUnderflow 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+                              then invalid else done InputUnderflow ir ow                         _ -> do                            c1 <- readWord8Buf iraw (ir+1)                            c2 <- readWord8Buf iraw (ir+2)@@ -161,17 +178,17 @@                            loop (ir+3) ow'                   | c0 >= 0xf0 ->                       case iw - ir of-                        1 -> done ir ow+                        1 -> done InputUnderflow 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+                              then invalid else done InputUnderflow 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+                              then invalid else done InputUnderflow ir ow                         _ -> do                            c1 <- readWord8Buf iraw (ir+1)                            c2 <- readWord8Buf iraw (ir+2)@@ -182,30 +199,28 @@                   | otherwise ->                            invalid          where-           invalid = if ir > ir0 then done ir ow else ioe_decodingError+           invalid = done InvalidSequence ir 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 })+       done why !ir !ow = return (why,+                                  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 })+      done why !ir !ow = return (why,+                                 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+        | ow >= os = done OutputUnderflow ir ow+        | ir >= iw = done InputUnderflow ir ow         | otherwise = do            (c,ir') <- readCharBuf iraw ir            case ord c of@@ -213,20 +228,20 @@                     writeWord8Buf oraw ow (fromIntegral x)                     loop ir' (ow+1)                | x <= 0x07FF ->-                    if os - ow < 2 then done ir ow else do+                    if os - ow < 2 then done OutputUnderflow 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+               | x <= 0xFFFF -> if isSurrogate c then done InvalidSequence ir ow else do+                    if os - ow < 3 then done OutputUnderflow 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+                    if os - ow < 4 then done OutputUnderflow ir ow else do                     let (c1,c2,c3,c4) = ord4 c                     writeWord8Buf oraw ow     c1                     writeWord8Buf oraw (ow+1) c2
GHC/IO/Exception.hs view
@@ -1,4 +1,6 @@-{-# OPTIONS_GHC -XNoImplicitPrelude -funbox-strict-fields #-}+{-# LANGUAGE Trustworthy #-}+{-# LANGUAGE NoImplicitPrelude, DeriveDataTypeable, MagicHash #-}+{-# OPTIONS_GHC -funbox-strict-fields #-} {-# OPTIONS_HADDOCK hide #-} ----------------------------------------------------------------------------- -- |
GHC/IO/Exception.hs-boot view
@@ -1,4 +1,5 @@-{-# OPTIONS -fno-implicit-prelude #-}+{-# LANGUAGE Trustworthy #-}+{-# LANGUAGE NoImplicitPrelude #-} module GHC.IO.Exception where  import GHC.Base
GHC/IO/FD.hs view
@@ -1,12 +1,19 @@-{-# OPTIONS_GHC -XNoImplicitPrelude -XBangPatterns #-}+{-# LANGUAGE CPP+           , NoImplicitPrelude+           , BangPatterns+           , ForeignFunctionInterface+           , DeriveDataTypeable+  #-}+{-# OPTIONS_GHC -fno-warn-identities #-} -- Whether there are identities depends on the platform {-# 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@@ -16,12 +23,12 @@ -----------------------------------------------------------------------------  module GHC.IO.FD (-  FD(..),-  openFile, mkFD, release,-  setNonBlockingMode,-  readRawBufferPtr, readRawBufferPtrNoBlock, writeRawBufferPtr,-  stdin, stdout, stderr-  ) where+        FD(..),+        openFile, mkFD, release,+        setNonBlockingMode,+        readRawBufferPtr, readRawBufferPtrNoBlock, writeRawBufferPtr,+        stdin, stdout, stderr+    ) where  import GHC.Base import GHC.Num@@ -40,13 +47,15 @@ import GHC.IO.Device (SeekMode(..), IODeviceType(..)) import GHC.Conc.IO import GHC.IO.Exception+#ifdef mingw32_HOST_OS+import GHC.Windows+#endif  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  c_DEBUG_DUMP :: Bool c_DEBUG_DUMP = False@@ -132,10 +141,14 @@ -- 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 =+-- size when the `IOMode` is `WriteMode`.+openFile+  :: FilePath -- ^ file to open+  -> IOMode   -- ^ mode in which to open the file+  -> Bool     -- ^ open the file in non-blocking mode?+  -> IO (FD,IODeviceType)++openFile filepath iomode non_blocking =   withFilePath filepath $ \ f ->      let @@ -155,7 +168,10 @@       binary_flags = 0 #endif       -      oflags = oflags1 .|. binary_flags+      oflags2 = oflags1 .|. binary_flags++      oflags | non_blocking = oflags2 .|. nonblock_flags+             | otherwise    = oflags2     in do      -- the old implementation had a complicated series of three opens,@@ -164,11 +180,12 @@     -- 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 oflags 0o666)+                (if non_blocking then c_open      f oflags 0o666+                                 else c_safe_open f oflags 0o666)      (fD,fd_type) <- mkFD fd iomode Nothing{-no stat-}                             False{-not a socket-} -                            True{-is non-blocking-}+                            non_blocking             `catchAny` \e -> do _ <- c_close fd                                 throwIO e @@ -184,13 +201,14 @@     return (fD,fd_type)  std_flags, output_flags, read_flags, write_flags, rw_flags,-    append_flags :: CInt-std_flags    = o_NONBLOCK   .|. o_NOCTTY+    append_flags, nonblock_flags :: CInt+std_flags    = 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+nonblock_flags = o_NONBLOCK   -- | Make a 'FD' from an existing file descriptor.  Fails if the FD@@ -603,9 +621,6 @@       -- for this case.  We need to detect EPIPE correctly, because it       -- shouldn't be reported as an error when it happens on stdout. -foreign import ccall unsafe "maperrno"             -- in Win32Utils.c-   c_maperrno :: IO ()- -- NOTE: "safe" versions of the read/write calls for use by the threaded RTS. -- These calls may block, but that's ok. @@ -648,8 +663,3 @@ foreign import ccall unsafe "unlockFile"   unlockFile :: CInt -> IO CInt #endif--puts :: String -> IO ()-puts s = do _ <- withCStringLen s $ \(p,len) ->-                     c_write 1 (castPtr p) (fromIntegral len)-            return ()
GHC/IO/Handle.hs view
@@ -1,5 +1,10 @@+{-# LANGUAGE Trustworthy #-}+{-# LANGUAGE CPP+           , NoImplicitPrelude+           , RecordWildCards+           , NondecreasingIndentation+  #-} {-# OPTIONS_GHC -fno-warn-unused-matches #-}-{-# LANGUAGE NoImplicitPrelude, RecordWildCards #-}  ----------------------------------------------------------------------------- -- |@@ -547,7 +552,7 @@ -- | 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+-- This has the same effect as calling 'hSetEncoding' with 'char8', together -- with 'hSetNewlineMode' with 'noNewlineTranslation'. -- hSetBinaryMode :: Handle -> Bool -> IO ()
GHC/IO/Handle.hs-boot view
@@ -1,4 +1,5 @@-{-# OPTIONS_GHC -XNoImplicitPrelude #-}+{-# LANGUAGE Trustworthy #-}+{-# LANGUAGE NoImplicitPrelude #-}  module GHC.IO.Handle where
GHC/IO/Handle/FD.hs view
@@ -1,4 +1,6 @@-{-# OPTIONS_GHC -XNoImplicitPrelude #-}+{-# LANGUAGE Trustworthy #-}+{-# LANGUAGE CPP, NoImplicitPrelude, PatternGuards, ForeignFunctionInterface #-}+ ----------------------------------------------------------------------------- -- | -- Module      :  GHC.IO.Handle.FD@@ -15,7 +17,7 @@  module GHC.IO.Handle.FD (    stdin, stdout, stderr,-  openFile, openBinaryFile,+  openFile, openBinaryFile, openFileBlocking,   mkHandleFromFD, fdToHandle, fdToHandle',   isEOF  ) where@@ -23,19 +25,16 @@ import GHC.Base 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 @@ -89,9 +88,9 @@  -- 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 ()+setBinaryMode :: FD.FD -> IO () #ifdef mingw32_HOST_OS-setBinaryMode fd = do _ <- setmode (fdFD fd) True+setBinaryMode fd = do _ <- setmode (FD.fdFD fd) True                       return () #else setBinaryMode _ = return ()@@ -147,9 +146,19 @@ openFile :: FilePath -> IOMode -> IO Handle openFile fp im =    catchException-    (openFile' fp im dEFAULT_OPEN_IN_BINARY_MODE)+    (openFile' fp im dEFAULT_OPEN_IN_BINARY_MODE True)     (\e -> ioError (addFilePathToIOError "openFile" fp e)) +-- | Like 'openFile', but opens the file in ordinary blocking mode.+-- This can be useful for opening a FIFO for reading: if we open in+-- non-blocking mode then the open will fail if there are no writers,+-- whereas a blocking open will block until a writer appears.+openFileBlocking :: FilePath -> IOMode -> IO Handle+openFileBlocking fp im =+  catchException+    (openFile' fp im dEFAULT_OPEN_IN_BINARY_MODE False)+    (\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.@@ -162,18 +171,20 @@ openBinaryFile :: FilePath -> IOMode -> IO Handle openBinaryFile fp m =   catchException-    (openFile' fp m True)+    (openFile' fp m True True)     (\e -> ioError (addFilePathToIOError "openBinaryFile" fp e)) -openFile' :: String -> IOMode -> Bool -> IO Handle-openFile' filepath iomode binary = do+openFile' :: String -> IOMode -> Bool -> Bool -> IO Handle+openFile' filepath iomode binary non_blocking = do   -- first open the file to get an FD-  (fd, fd_type) <- FD.openFile filepath iomode+  (fd, fd_type) <- FD.openFile filepath iomode non_blocking    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+  mkHandleFromFD fd fd_type filepath iomode+                   False {- do not *set* non-blocking mode -}+                   mb_codec             `onException` IODevice.close fd         -- NB. don't forget to close the FD if mkHandleFromFD fails, otherwise         -- this FD leaks.@@ -186,11 +197,11 @@ -- Converting file descriptors to Handles  mkHandleFromFD-   :: FD+   :: FD.FD    -> IODeviceType-   -> FilePath -- a string describing this file descriptor (e.g. the filename)+   -> FilePath  -- a string describing this file descriptor (e.g. the filename)    -> IOMode-   -> Bool -- non_blocking (*sets* non-blocking mode on the FD)+   -> Bool      --  *set* non-blocking mode on the FD    -> Maybe TextEncoding    -> IO Handle
GHC/IO/Handle/FD.hs-boot view
@@ -1,4 +1,5 @@-{-# OPTIONS_GHC -XNoImplicitPrelude #-}+{-# LANGUAGE Trustworthy #-}+{-# LANGUAGE NoImplicitPrelude #-} module GHC.IO.Handle.FD where  import GHC.IO.Handle.Types
GHC/IO/Handle/Internals.hs view
@@ -1,7 +1,14 @@+{-# LANGUAGE Trustworthy #-}+{-# LANGUAGE NoImplicitPrelude+           , RecordWildCards+           , BangPatterns+           , PatternGuards+           , NondecreasingIndentation+           , Rank2Types+  #-} {-# OPTIONS_GHC -fno-warn-unused-matches #-} {-# OPTIONS_GHC -fno-warn-name-shadowing #-} {-# OPTIONS_HADDOCK hide #-}-{-# LANGUAGE NoImplicitPrelude, RecordWildCards, BangPatterns #-}  ----------------------------------------------------------------------------- -- |@@ -69,8 +76,7 @@ import Data.Typeable import Control.Monad import Data.Maybe-import Foreign hiding (unsafePerformIO)--- import System.IO.Error+import Foreign.Safe import System.Posix.Internals hiding (FD)  import Foreign.C@@ -349,6 +355,38 @@         ("illegal buffer size " ++ showsPrec 9 n []) Nothing Nothing)                                 -- 9 => should be parens'ified. +-- ---------------------------------------------------------------------------+-- Wrapper for Handle encoding/decoding.++-- The interface for TextEncoding changed so that a TextEncoding doesn't raise+-- an exception if it encounters an invalid sequnce. Furthermore, encoding+-- returns a reason as to why encoding stopped, letting us know if it was due+-- to input/output underflow or an invalid sequence.+--+-- This code adapts this elaborated interface back to the original TextEncoding+-- interface.+--+-- FIXME: it is possible that Handle code using the haDecoder/haEncoder fields+-- could be made clearer by using the 'encode' interface directly. I have not+-- looked into this.+--+-- FIXME: we should use recover to deal with EOF, rather than always throwing an+-- IOException (ioe_invalidCharacter).++streamEncode :: BufferCodec from to state+             -> Buffer from -> Buffer to+             -> IO (Buffer from, Buffer to)+streamEncode codec from to = go (from, to)+  where +    go (from, to) = do+      (why, from', to') <- encode codec from to+      -- When we are dealing with Handles, we don't care about input/output+      -- underflow particularly, and we want to delay errors about invalid+      -- sequences as far as possible.+      case why of+        Encoding.InvalidSequence | bufL from == bufL from' -> recover codec from' to' >>= go+        _ -> return (from', to')+ -- ----------------------------------------------------------------------------- -- Handle Finalizers @@ -470,7 +508,7 @@    (cbuf',bbuf') <- case haEncoder of     Nothing      -> latin1_encode cbuf bbuf-    Just encoder -> (encode encoder) cbuf bbuf+    Just encoder -> (streamEncode encoder) cbuf bbuf    debugIO ("writeCharBuffer after encoding: cbuf=" ++ summaryBuffer cbuf' ++         " bbuf=" ++ summaryBuffer bbuf')@@ -531,7 +569,7 @@       -- restore the codec state       setState decoder codec_state     -      (bbuf1,cbuf1) <- (encode decoder) bbuf0+      (bbuf1,cbuf1) <- (streamEncode decoder) bbuf0                                cbuf0{ bufL=0, bufR=0, bufSize = bufL cbuf0 }            debugIO ("finished, bbuf=" ++ summaryBuffer bbuf1 ++@@ -795,7 +833,7 @@           Just decoder -> do                state <- getState decoder                writeIORef haLastDecode (state, bbuf1)-               (encode decoder) bbuf1 cbuf+               (streamEncode decoder) bbuf1 cbuf    debugIO ("readTextDevice after decoding: cbuf=" ++ summaryBuffer cbuf' ++          " bbuf=" ++ summaryBuffer bbuf2)@@ -819,7 +857,7 @@                  then ioe_invalidCharacter                  else return bbuf2 -  debugIO ("readTextDevice after reading: bbuf=" ++ summaryBuffer bbuf2)+  debugIO ("readTextDevice' after reading: bbuf=" ++ summaryBuffer bbuf2)    (bbuf3,cbuf') <-        case haDecoder of@@ -829,9 +867,9 @@           Just decoder -> do                state <- getState decoder                writeIORef haLastDecode (state, bbuf2)-               (encode decoder) bbuf2 cbuf+               (streamEncode decoder) bbuf2 cbuf -  debugIO ("readTextDevice after decoding: cbuf=" ++ summaryBuffer cbuf' ++ +  debugIO ("readTextDevice' after decoding: cbuf=" ++ summaryBuffer cbuf' ++          " bbuf=" ++ summaryBuffer bbuf3)    writeIORef haByteBuffer bbuf3@@ -866,7 +904,7 @@           Just decoder -> do                state <- getState decoder                writeIORef haLastDecode (state, bbuf0)-               (encode decoder) bbuf0 cbuf+               (streamEncode decoder) bbuf0 cbuf    writeIORef haByteBuffer bbuf2   return cbuf'
GHC/IO/Handle/Text.hs view
@@ -1,7 +1,16 @@+{-# LANGUAGE Trustworthy #-}+{-# LANGUAGE CPP+           , NoImplicitPrelude+           , RecordWildCards+           , BangPatterns+           , PatternGuards+           , NondecreasingIndentation+           , MagicHash+           , ForeignFunctionInterface+  #-} {-# OPTIONS_GHC -fno-warn-name-shadowing #-} {-# OPTIONS_GHC -fno-warn-unused-matches #-} {-# OPTIONS_HADDOCK hide #-}-{-# LANGUAGE NoImplicitPrelude, RecordWildCards, BangPatterns #-}  ----------------------------------------------------------------------------- -- |@@ -19,17 +28,18 @@  -- #hide module GHC.IO.Handle.Text ( -   hWaitForInput, hGetChar, hGetLine, hGetContents, hPutChar, hPutStr,-   commitBuffer',       -- hack, see below-   hGetBuf, hGetBufSome, hGetBufNonBlocking, hPutBuf, hPutBufNonBlocking,-   memcpy, hPutStrLn,- ) where+        hWaitForInput, hGetChar, hGetLine, hGetContents, hPutChar, hPutStr,+        commitBuffer',       -- hack, see below+        hGetBuf, hGetBufSome, hGetBufNonBlocking, hPutBuf, hPutBufNonBlocking,+        memcpy, hPutStrLn,+    ) 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.IO.Encoding.Failure (surrogatifyRoundtripCharacter, desurrogatifyRoundtripCharacter) import GHC.Exception import GHC.IO.Handle.Types import GHC.IO.Handle.Internals@@ -39,6 +49,7 @@ import Foreign import Foreign.C +import qualified Control.Exception as Exception import Data.Typeable import System.IO.Error import Data.Maybe@@ -240,12 +251,12 @@  maybeFillReadBuffer :: Handle__ -> CharBuffer -> IO (Maybe CharBuffer) maybeFillReadBuffer handle_ buf-  = catch +  = Exception.catch      (do buf' <- getSomeCharacters handle_ buf          return (Just buf')      )-     (\e -> do if isEOFError e -                  then return Nothing +     (\e -> do if isEOFError e+                  then return Nothing                   else ioError e)  -- See GHC.IO.Buffer@@ -270,10 +281,10 @@                  else do c1 <- peekElemOff pbuf (i-1)                          let c = (fromIntegral c1 - 0xd800) * 0x400 +                                  (fromIntegral c2 - 0xdc00) + 0x10000-                         unpackRB (unsafeChr c : acc) (i-2)+                         unpackRB (desurrogatifyRoundtripCharacter (unsafeChr c) : acc) (i-2) #else               c <- peekElemOff pbuf i-              unpackRB (c:acc) (i-1)+              unpackRB (desurrogatifyRoundtripCharacter c:acc) (i-1) #endif      in      unpackRB acc0 (w-1)@@ -296,7 +307,7 @@                             then unpackRB ('\n':acc) (i-2)                             else unpackRB ('\n':acc) (i-1)                  else do-                         unpackRB (c:acc) (i-1)+                         unpackRB (desurrogatifyRoundtripCharacter c:acc) (i-1)      in do      c <- peekElemOff pbuf (w-1)      if (c == '\r')@@ -370,8 +381,8 @@ lazyReadBuffered :: Handle -> Handle__ -> IO (Handle__, [Char]) lazyReadBuffered h handle_@Handle__{..} = do    buf <- readIORef haCharBuffer-   catch -        (do +   Exception.catch+        (do             buf'@Buffer{..} <- getSomeCharacters handle_ buf             lazy_rest <- lazyRead h             (s,r) <- if haInputNL == CRLF@@ -576,7 +587,7 @@            else do                shoveString n' cs rest      | otherwise = do-        n' <- writeCharBuf raw n c+        n' <- writeCharBuf raw n (surrogatifyRoundtripCharacter c)         shoveString n' cs rest   in   shoveString 0 s (if add_nl then "\n" else "")
GHC/IO/Handle/Types.hs view
@@ -1,5 +1,12 @@-{-# OPTIONS_GHC  -XNoImplicitPrelude -funbox-strict-fields #-}+{-# LANGUAGE Trustworthy #-}+{-# LANGUAGE CPP+           , NoImplicitPrelude+           , ExistentialQuantification+           , DeriveDataTypeable+  #-}+{-# OPTIONS_GHC -funbox-strict-fields #-} {-# OPTIONS_HADDOCK hide #-}+ ----------------------------------------------------------------------------- -- | -- Module      :  GHC.IO.Handle.Types
GHC/IO/IOMode.hs view
@@ -1,4 +1,5 @@-{-# OPTIONS_GHC -XNoImplicitPrelude #-}+{-# LANGUAGE Trustworthy #-}+{-# LANGUAGE NoImplicitPrelude #-} {-# OPTIONS_HADDOCK hide #-} ----------------------------------------------------------------------------- -- |
GHC/IOArray.hs view
@@ -1,11 +1,12 @@-{-# OPTIONS_GHC -XNoImplicitPrelude -funbox-strict-fields #-}+{-# LANGUAGE NoImplicitPrelude #-}+{-# OPTIONS_GHC -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)@@ -15,25 +16,25 @@ -----------------------------------------------------------------------------  module GHC.IOArray (-    IOArray(..),-    newIOArray, unsafeReadIOArray, unsafeWriteIOArray,-    readIOArray, writeIOArray,-    boundsIOArray-  ) where+        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.  +-- | 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) @@ -65,5 +66,6 @@ writeIOArray (IOArray marr) i e = stToIO (writeSTArray marr i e)  {-# INLINE boundsIOArray #-}-boundsIOArray :: IOArray i e -> (i,i)  +boundsIOArray :: IOArray i e -> (i,i) boundsIOArray (IOArray marr) = boundsSTArray marr+
GHC/IOBase.hs view
@@ -1,4 +1,6 @@+{-# LANGUAGE DeriveDataTypeable #-} {-# OPTIONS_HADDOCK hide #-}+ ----------------------------------------------------------------------------- -- | -- Module      :  GHC.IOBase
GHC/IORef.hs view
@@ -1,11 +1,13 @@-{-# OPTIONS_GHC -XNoImplicitPrelude -funbox-strict-fields #-}+{-# LANGUAGE NoImplicitPrelude, MagicHash #-}+{-# OPTIONS_GHC -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)@@ -14,9 +16,9 @@ -- ----------------------------------------------------------------------------- module GHC.IORef (-    IORef(..),-    newIORef, readIORef, writeIORef, atomicModifyIORef-  ) where+        IORef(..),+        newIORef, readIORef, writeIORef, atomicModifyIORef+    ) where  import GHC.Base import GHC.STRef
GHC/Int.hs view
@@ -1,4 +1,6 @@-{-# OPTIONS_GHC -XNoImplicitPrelude #-}+{-# LANGUAGE Trustworthy #-}+{-# LANGUAGE CPP, NoImplicitPrelude, BangPatterns, MagicHash, +             StandaloneDeriving #-} {-# OPTIONS_HADDOCK hide #-} ----------------------------------------------------------------------------- -- |@@ -18,8 +20,8 @@  -- #hide module GHC.Int (-    Int8(..), Int16(..), Int32(..), Int64(..),-    uncheckedIShiftL64#, uncheckedIShiftRA64#+        Int8(..), Int16(..), Int32(..), Int64(..),+        uncheckedIShiftL64#, uncheckedIShiftRA64#     ) where  import Data.Bits@@ -42,6 +44,7 @@ import GHC.Show import GHC.Float ()     -- for RealFrac methods + ------------------------------------------------------------------------ -- type Int8 ------------------------------------------------------------------------@@ -65,7 +68,7 @@     signum x | x > 0       = 1     signum 0               = 0     signum _               = -1-    fromInteger i          = I8# (narrow8Int# (toInt# i))+    fromInteger i          = I8# (narrow8Int# (integerToInt i))  instance Real Int8 where     toRational x = toInteger x % 1@@ -88,28 +91,28 @@ instance Integral Int8 where     quot    x@(I8# x#) y@(I8# y#)         | y == 0                     = divZeroError-        | x == minBound && y == (-1) = overflowError+        | y == (-1) && x == minBound = overflowError -- Note [Order of tests]         | otherwise                  = I8# (narrow8Int# (x# `quotInt#` y#))-    rem     x@(I8# x#) y@(I8# y#)+    rem     (I8# x#) y@(I8# y#)         | y == 0                     = divZeroError-        | x == minBound && y == (-1) = overflowError         | otherwise                  = I8# (narrow8Int# (x# `remInt#` y#))     div     x@(I8# x#) y@(I8# y#)         | y == 0                     = divZeroError-        | x == minBound && y == (-1) = overflowError+        | y == (-1) && x == minBound = overflowError -- Note [Order of tests]         | otherwise                  = I8# (narrow8Int# (x# `divInt#` y#))-    mod     x@(I8# x#) y@(I8# y#)+    mod       (I8# x#) y@(I8# y#)         | y == 0                     = divZeroError-        | x == minBound && y == (-1) = overflowError         | otherwise                  = I8# (narrow8Int# (x# `modInt#` y#))     quotRem x@(I8# x#) y@(I8# y#)         | y == 0                     = divZeroError-        | x == minBound && y == (-1) = overflowError+          -- Note [Order of tests]+        | y == (-1) && x == minBound = (overflowError, 0)         | otherwise                  = (I8# (narrow8Int# (x# `quotInt#` y#)),                                        I8# (narrow8Int# (x# `remInt#` y#)))     divMod  x@(I8# x#) y@(I8# y#)         | y == 0                     = divZeroError-        | x == minBound && y == (-1) = overflowError+          -- Note [Order of tests]+        | y == (-1) && x == minBound = (overflowError, 0)         | otherwise                  = (I8# (narrow8Int# (x# `divInt#` y#)),                                        I8# (narrow8Int# (x# `modInt#` y#)))     toInteger (I8# x#)               = smallInteger x#@@ -207,7 +210,7 @@     signum x | x > 0       = 1     signum 0               = 0     signum _               = -1-    fromInteger i          = I16# (narrow16Int# (toInt# i))+    fromInteger i          = I16# (narrow16Int# (integerToInt i))  instance Real Int16 where     toRational x = toInteger x % 1@@ -230,28 +233,28 @@ instance Integral Int16 where     quot    x@(I16# x#) y@(I16# y#)         | y == 0                     = divZeroError-        | x == minBound && y == (-1) = overflowError+        | y == (-1) && x == minBound = overflowError -- Note [Order of tests]         | otherwise                  = I16# (narrow16Int# (x# `quotInt#` y#))-    rem     x@(I16# x#) y@(I16# y#)+    rem       (I16# x#) y@(I16# y#)         | y == 0                     = divZeroError-        | x == minBound && y == (-1) = overflowError         | otherwise                  = I16# (narrow16Int# (x# `remInt#` y#))     div     x@(I16# x#) y@(I16# y#)         | y == 0                     = divZeroError-        | x == minBound && y == (-1) = overflowError+        | y == (-1) && x == minBound = overflowError -- Note [Order of tests]         | otherwise                  = I16# (narrow16Int# (x# `divInt#` y#))-    mod     x@(I16# x#) y@(I16# y#)+    mod       (I16# x#) y@(I16# y#)         | y == 0                     = divZeroError-        | x == minBound && y == (-1) = overflowError         | otherwise                  = I16# (narrow16Int# (x# `modInt#` y#))     quotRem x@(I16# x#) y@(I16# y#)         | y == 0                     = divZeroError-        | x == minBound && y == (-1) = overflowError+          -- Note [Order of tests]+        | y == (-1) && x == minBound = (overflowError, 0)         | otherwise                  = (I16# (narrow16Int# (x# `quotInt#` y#)),                                         I16# (narrow16Int# (x# `remInt#` y#)))     divMod  x@(I16# x#) y@(I16# y#)         | y == 0                     = divZeroError-        | x == minBound && y == (-1) = overflowError+          -- Note [Order of tests]+        | y == (-1) && x == minBound = (overflowError, 0)         | otherwise                  = (I16# (narrow16Int# (x# `divInt#` y#)),                                         I16# (narrow16Int# (x# `modInt#` y#)))     toInteger (I16# x#)              = smallInteger x#@@ -384,28 +387,36 @@ instance Integral Int32 where     quot    x@(I32# x#) y@(I32# y#)         | y == 0                     = divZeroError-        | x == minBound && y == (-1) = overflowError+        | y == (-1) && x == minBound = overflowError -- Note [Order of tests]         | otherwise                  = I32# (x# `quotInt32#` y#)-    rem     x@(I32# x#) y@(I32# y#)+    rem       (I32# x#) y@(I32# y#)         | y == 0                  = divZeroError-        | x == minBound && y == (-1) = overflowError+          -- The quotRem CPU instruction fails for minBound `quotRem` -1,+          -- but minBound `rem` -1 is well-defined (0). We therefore+          -- special-case it.+        | y == (-1)               = 0         | otherwise               = I32# (x# `remInt32#` y#)     div     x@(I32# x#) y@(I32# y#)         | y == 0                  = divZeroError-        | x == minBound && y == (-1) = overflowError+        | y == (-1) && x == minBound = overflowError -- Note [Order of tests]         | otherwise               = I32# (x# `divInt32#` y#)-    mod     x@(I32# x#) y@(I32# y#)+    mod       (I32# x#) y@(I32# y#)         | y == 0                  = divZeroError-        | x == minBound && y == (-1) = overflowError+          -- The divMod CPU instruction fails for minBound `divMod` -1,+          -- but minBound `mod` -1 is well-defined (0). We therefore+          -- special-case it.+        | y == (-1)               = 0         | otherwise               = I32# (x# `modInt32#` y#)     quotRem x@(I32# x#) y@(I32# y#)         | y == 0                  = divZeroError-        | x == minBound && y == (-1) = overflowError+          -- Note [Order of tests]+        | y == (-1) && x == minBound = (overflowError, 0)         | otherwise               = (I32# (x# `quotInt32#` y#),                                      I32# (x# `remInt32#` y#))     divMod  x@(I32# x#) y@(I32# y#)         | y == 0                  = divZeroError-        | x == minBound && y == (-1) = overflowError+          -- Note [Order of tests]+        | y == (-1) && x == minBound = (overflowError, 0)         | otherwise               = (I32# (x# `divInt32#` y#),                                      I32# (x# `modInt32#` y#))     toInteger x@(I32# x#)@@ -489,7 +500,7 @@     signum x | x > 0       = 1     signum 0               = 0     signum _               = -1-    fromInteger i          = I32# (narrow32Int# (toInt# i))+    fromInteger i          = I32# (narrow32Int# (integerToInt i))  instance Enum Int32 where     succ x@@ -513,28 +524,36 @@ instance Integral Int32 where     quot    x@(I32# x#) y@(I32# y#)         | y == 0                     = divZeroError-        | x == minBound && y == (-1) = overflowError+        | y == (-1) && x == minBound = overflowError -- Note [Order of tests]         | otherwise                  = I32# (narrow32Int# (x# `quotInt#` y#))-    rem     x@(I32# x#) y@(I32# y#)+    rem       (I32# x#) y@(I32# y#)         | y == 0                     = divZeroError-        | x == minBound && y == (-1) = overflowError+          -- The quotRem CPU instruction fails for minBound `quotRem` -1,+          -- but minBound `rem` -1 is well-defined (0). We therefore+          -- special-case it.+        | y == (-1)                  = 0         | otherwise                  = I32# (narrow32Int# (x# `remInt#` y#))     div     x@(I32# x#) y@(I32# y#)         | y == 0                     = divZeroError-        | x == minBound && y == (-1) = overflowError+        | y == (-1) && x == minBound = overflowError -- Note [Order of tests]         | otherwise                  = I32# (narrow32Int# (x# `divInt#` y#))-    mod     x@(I32# x#) y@(I32# y#)+    mod       (I32# x#) y@(I32# y#)         | y == 0                     = divZeroError-        | x == minBound && y == (-1) = overflowError+          -- The divMod CPU instruction fails for minBound `divMod` -1,+          -- but minBound `mod` -1 is well-defined (0). We therefore+          -- special-case it.+        | y == (-1)                  = 0         | otherwise                  = I32# (narrow32Int# (x# `modInt#` y#))     quotRem x@(I32# x#) y@(I32# y#)         | y == 0                     = divZeroError-        | x == minBound && y == (-1) = overflowError+          -- Note [Order of tests]+        | y == (-1) && x == minBound = (overflowError, 0)         | otherwise                  = (I32# (narrow32Int# (x# `quotInt#` y#)),                                      I32# (narrow32Int# (x# `remInt#` y#)))     divMod  x@(I32# x#) y@(I32# y#)         | y == 0                     = divZeroError-        | x == minBound && y == (-1) = overflowError+          -- Note [Order of tests]+        | y == (-1) && x == minBound = (overflowError, 0)         | otherwise                  = (I32# (narrow32Int# (x# `divInt#` y#)),                                      I32# (narrow32Int# (x# `modInt#` y#)))     toInteger (I32# x#)              = smallInteger x#@@ -672,28 +691,36 @@ instance Integral Int64 where     quot    x@(I64# x#) y@(I64# y#)         | y == 0                     = divZeroError-        | x == minBound && y == (-1) = overflowError+        | y == (-1) && x == minBound = overflowError -- Note [Order of tests]         | otherwise                  = I64# (x# `quotInt64#` y#)-    rem     x@(I64# x#) y@(I64# y#)+    rem       (I64# x#) y@(I64# y#)         | y == 0                     = divZeroError-        | x == minBound && y == (-1) = overflowError+          -- The quotRem CPU instruction fails for minBound `quotRem` -1,+          -- but minBound `rem` -1 is well-defined (0). We therefore+          -- special-case it.+        | y == (-1)                  = 0         | otherwise                  = I64# (x# `remInt64#` y#)     div     x@(I64# x#) y@(I64# y#)         | y == 0                     = divZeroError-        | x == minBound && y == (-1) = overflowError+        | y == (-1) && x == minBound = overflowError -- Note [Order of tests]         | otherwise                  = I64# (x# `divInt64#` y#)-    mod     x@(I64# x#) y@(I64# y#)+    mod       (I64# x#) y@(I64# y#)         | y == 0                     = divZeroError-        | x == minBound && y == (-1) = overflowError+          -- The divMod CPU instruction fails for minBound `divMod` -1,+          -- but minBound `mod` -1 is well-defined (0). We therefore+          -- special-case it.+        | y == (-1)                  = 0         | otherwise                  = I64# (x# `modInt64#` y#)     quotRem x@(I64# x#) y@(I64# y#)         | y == 0                     = divZeroError-        | x == minBound && y == (-1) = overflowError+          -- Note [Order of tests]+        | y == (-1) && x == minBound = (overflowError, 0)         | otherwise                  = (I64# (x# `quotInt64#` y#),                                         I64# (x# `remInt64#` y#))     divMod  x@(I64# x#) y@(I64# y#)         | y == 0                     = divZeroError-        | x == minBound && y == (-1) = overflowError+          -- Note [Order of tests]+        | y == (-1) && x == minBound = (overflowError, 0)         | otherwise                  = (I64# (x# `divInt64#` y#),                                         I64# (x# `modInt64#` y#))     toInteger (I64# x)               = int64ToInteger x@@ -788,7 +815,7 @@     signum x | x > 0       = 1     signum 0               = 0     signum _               = -1-    fromInteger i          = I64# (toInt# i)+    fromInteger i          = I64# (integerToInt i)  instance Enum Int64 where     succ x@@ -805,27 +832,35 @@ instance Integral Int64 where     quot    x@(I64# x#) y@(I64# y#)         | y == 0                     = divZeroError-        | x == minBound && y == (-1) = overflowError+        | y == (-1) && x == minBound = overflowError -- Note [Order of tests]         | otherwise                  = I64# (x# `quotInt#` y#)-    rem     x@(I64# x#) y@(I64# y#)+    rem       (I64# x#) y@(I64# y#)         | y == 0                     = divZeroError-        | x == minBound && y == (-1) = overflowError+          -- The quotRem CPU instruction fails for minBound `quotRem` -1,+          -- but minBound `rem` -1 is well-defined (0). We therefore+          -- special-case it.+        | y == (-1)                  = 0         | otherwise                  = I64# (x# `remInt#` y#)     div     x@(I64# x#) y@(I64# y#)         | y == 0                     = divZeroError-        | x == minBound && y == (-1) = overflowError+        | y == (-1) && x == minBound = overflowError -- Note [Order of tests]         | otherwise                  = I64# (x# `divInt#` y#)-    mod     x@(I64# x#) y@(I64# y#)+    mod       (I64# x#) y@(I64# y#)         | y == 0                     = divZeroError-        | x == minBound && y == (-1) = overflowError+          -- The divMod CPU instruction fails for minBound `divMod` -1,+          -- but minBound `mod` -1 is well-defined (0). We therefore+          -- special-case it.+        | y == (-1)                  = 0         | otherwise                  = I64# (x# `modInt#` y#)     quotRem x@(I64# x#) y@(I64# y#)         | y == 0                     = divZeroError-        | x == minBound && y == (-1) = overflowError+          -- Note [Order of tests]+        | y == (-1) && x == minBound = (overflowError, 0)         | otherwise                  = (I64# (x# `quotInt#` y#), I64# (x# `remInt#` y#))     divMod  x@(I64# x#) y@(I64# y#)         | y == 0                     = divZeroError-        | x == minBound && y == (-1) = overflowError+          -- Note [Order of tests]+        | y == (-1) && x == minBound = (overflowError, 0)         | otherwise                  = (I64# (x# `divInt#` y#), I64# (x# `modInt#` y#))     toInteger (I64# x#)              = smallInteger x# @@ -907,3 +942,128 @@     range (m,n)         = [m..n]     unsafeIndex (m,_) i = fromIntegral i - fromIntegral m     inRange (m,n) i     = m <= i && i <= n+++{-+Note [Order of tests]++Suppose we had a definition like:++    quot x y+     | y == 0                     = divZeroError+     | x == minBound && y == (-1) = overflowError+     | otherwise                  = x `primQuot` y++Note in particular that the+    x == minBound+test comes before the+    y == (-1)+test.++this expands to something like:++    case y of+    0 -> divZeroError+    _ -> case x of+         -9223372036854775808 ->+             case y of+             -1 -> overflowError+             _ -> x `primQuot` y+         _ -> x `primQuot` y++Now if we have the call (x `quot` 2), and quot gets inlined, then we get:++    case 2 of+    0 -> divZeroError+    _ -> case x of+         -9223372036854775808 ->+             case 2 of+             -1 -> overflowError+             _ -> x `primQuot` 2+         _ -> x `primQuot` 2++which simplifies to:++    case x of+    -9223372036854775808 -> x `primQuot` 2+    _                    -> x `primQuot` 2++Now we have a case with two identical branches, which would be+eliminated (assuming it doesn't affect strictness, which it doesn't in+this case), leaving the desired:++    x `primQuot` 2++except in the minBound branch we know what x is, and GHC cleverly does+the division at compile time, giving:++    case x of+    -9223372036854775808 -> -4611686018427387904+    _                    -> x `primQuot` 2++So instead we use a definition like:++    quot x y+     | y == 0                     = divZeroError+     | y == (-1) && x == minBound = overflowError+     | otherwise                  = x `primQuot` y++which gives us:++    case y of+    0 -> divZeroError+    -1 ->+        case x of+        -9223372036854775808 -> overflowError+        _ -> x `primQuot` y+    _ -> x `primQuot` y++for which our call (x `quot` 2) expands to:++    case 2 of+    0 -> divZeroError+    -1 ->+        case x of+        -9223372036854775808 -> overflowError+        _ -> x `primQuot` 2+    _ -> x `primQuot` 2++which simplifies to:++    x `primQuot` 2++as required.++++But we now have the same problem with a constant numerator: the call+(2 `quot` y) expands to++    case y of+    0 -> divZeroError+    -1 ->+        case 2 of+        -9223372036854775808 -> overflowError+        _ -> 2 `primQuot` y+    _ -> 2 `primQuot` y++which simplifies to:++    case y of+    0 -> divZeroError+    -1 -> 2 `primQuot` y+    _ -> 2 `primQuot` y++which simplifies to:++    case y of+    0 -> divZeroError+    -1 -> -2+    _ -> 2 `primQuot` y+++However, constant denominators are more common than constant numerators,+so the+    y == (-1) && x == minBound+order gives us better code in the common case.+-}
GHC/List.lhs view
@@ -1,6 +1,8 @@ \begin{code}-{-# OPTIONS_GHC -XNoImplicitPrelude #-}+{-# LANGUAGE Trustworthy #-}+{-# LANGUAGE CPP, NoImplicitPrelude, MagicHash #-} {-# OPTIONS_HADDOCK hide #-}+ ----------------------------------------------------------------------------- -- | -- Module      :  GHC.List@@ -335,7 +337,8 @@ -- > splitAt 0 [1,2,3] == ([],[1,2,3]) -- > splitAt (-1) [1,2,3] == ([],[1,2,3]) ----- It is equivalent to @('take' n xs, 'drop' n xs)@.+-- It is equivalent to @('take' n xs, 'drop' n xs)@ when @n@ is not @_|_@+-- (@splitAt _|_ xs = _|_@). -- 'splitAt' is an instance of the more general 'Data.List.genericSplitAt', -- in which @n@ may be of any integral type. splitAt                :: Int -> [a] -> ([a],[a])
GHC/MVar.hs view
@@ -1,11 +1,13 @@-{-# OPTIONS_GHC -XNoImplicitPrelude -funbox-strict-fields #-}+{-# LANGUAGE NoImplicitPrelude, MagicHash, UnboxedTuples #-}+{-# OPTIONS_GHC -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)@@ -25,11 +27,10 @@         , tryPutMVar    -- :: MVar a -> a -> IO Bool         , isEmptyMVar   -- :: MVar a -> IO Bool         , addMVarFinalizer -- :: MVar a -> IO () -> IO ()--  ) where+    ) where  import GHC.Base-import GHC.IO()   -- instance Monad IO+import GHC.IO ()   -- instance Monad IO import Data.Maybe  data MVar a = MVar (MVar# RealWorld a)@@ -69,9 +70,9 @@     return mvar  -- |Return the contents of the 'MVar'.  If the 'MVar' is currently--- empty, 'takeMVar' will wait until it is full.  After a 'takeMVar', +-- 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@@ -131,13 +132,13 @@ -- 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# -> +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 = +addMVarFinalizer (MVar m) finalizer =   IO $ \s -> case mkWeak# m () finalizer s of { (# s1, _ #) -> (# s1, () #) }
GHC/Num.lhs view
@@ -1,5 +1,6 @@ \begin{code}-{-# OPTIONS_GHC -XNoImplicitPrelude #-}+{-# LANGUAGE Trustworthy #-}+{-# LANGUAGE CPP, NoImplicitPrelude, MagicHash, UnboxedTuples #-} -- We believe we could deorphan this module, by moving lots of things -- around, but we haven't got there yet: {-# OPTIONS_GHC -fno-warn-orphans #-}@@ -112,7 +113,7 @@              | otherwise   = 1      {-# INLINE fromInteger #-}	 -- Just to be sure!-    fromInteger i = I# (toInt# i)+    fromInteger i = I# (integerToInt i)  quotRemInt :: Int -> Int -> (Int, Int) quotRemInt a@(I# _) b@(I# _) = (a `quotInt` b, a `remInt` b)@@ -250,7 +251,7 @@     succ x               = x + 1     pred x               = x - 1     toEnum (I# n)        = smallInteger n-    fromEnum n           = I# (toInt# n)+    fromEnum n           = I# (integerToInt n)      {-# INLINE enumFrom #-}     {-# INLINE enumFromThen #-}
GHC/PArr.hs view
@@ -1,732 +1,29 @@+{-# LANGUAGE Trustworthy #-}+{-# LANGUAGE ParallelArrays, MagicHash #-} {-# OPTIONS_GHC -funbox-strict-fields #-}-{-# OPTIONS_GHC -fno-warn-incomplete-patterns #-}-{-# LANGUAGE PArr #-}+{-# OPTIONS_HADDOCK hide #-}  ----------------------------------------------------------------------------- -- | -- Module      :  GHC.PArr--- Copyright   :  (c) 2001-2002 Manuel M T Chakravarty & Gabriele Keller+-- Copyright   :  (c) 2001-2011 The Data Parallel Haskell team -- License     :  see libraries/base/LICENSE -- --- Maintainer  :  Manuel M. T. Chakravarty <chak@cse.unsw.edu.au>+-- Maintainer  :  cvs-ghc@haskell.org -- Stability   :  internal -- Portability :  non-portable (GHC Extensions) -----  Basic implementation of Parallel Arrays.------  This module has two functions: (1) It defines the interface to the---  parallel array extension of the Prelude and (2) it provides a vanilla---  implementation of parallel arrays that does not require to flatten the---  array code.  The implementation is not very optimised.------- DOCU ----------------------------------------------------------------------------  Language: Haskell 98 plus unboxed values and parallel arrays------  The semantic difference between standard Haskell arrays (aka "lazy---  arrays") and parallel arrays (aka "strict arrays") is that the evaluation---  of two different elements of a lazy array is independent, whereas in a---  strict array either non or all elements are evaluated.  In other words,---  when a parallel array is evaluated to WHNF, all its elements will be---  evaluated to WHNF.  The name parallel array indicates that all array---  elements may, in general, be evaluated to WHNF in parallel without any---  need to resort to speculative evaluation.  This parallel evaluation---  semantics is also beneficial in the sequential case, as it facilitates---  loop-based array processing as known from classic array-based languages,---  such as Fortran.------  The interface of this module is essentially a variant of the list---  component of the Prelude, but also includes some functions (such as---  permutations) that are not provided for lists.  The following list---  operations are not supported on parallel arrays, as they would require the---  availability of infinite parallel arrays: `iterate', `repeat', and `cycle'.------  The current implementation is quite simple and entirely based on boxed---  arrays.  One disadvantage of boxed arrays is that they require to---  immediately initialise all newly allocated arrays with an error thunk to---  keep the garbage collector happy, even if it is guaranteed that the array---  is fully initialised with different values before passing over the---  user-visible interface boundary.  Currently, no effort is made to use---  raw memory copy operations to speed things up.------- TODO ----------------------------------------------------------------------------  * We probably want a standard library `PArray' in addition to the prelude---    extension in the same way as the standard library `List' complements the---    list functions from the prelude.------  * Currently, functions that emphasis the constructor-based definition of---    lists (such as, head, last, tail, and init) are not supported.  ------    Is it worthwhile to support the string processing functions lines,---    words, unlines, and unwords?  (Currently, they are not implemented.)------    It can, however, be argued that it would be worthwhile to include them---    for completeness' sake; maybe only in the standard library `PArray'.------  * Prescans are often more useful for array programming than scans.  Shall---    we include them into the Prelude or the library?------  * Due to the use of the iterator `loop', we could define some fusion rules---    in this module.------  * We might want to add bounds checks that can be deactivated.--- -module GHC.PArr (-  -- [::],              -- Built-in syntax--  mapP,                 -- :: (a -> b) -> [:a:] -> [:b:]-  (+:+),                -- :: [:a:] -> [:a:] -> [:a:]-  filterP,              -- :: (a -> Bool) -> [:a:] -> [:a:]-  concatP,              -- :: [:[:a:]:] -> [:a:]-  concatMapP,           -- :: (a -> [:b:]) -> [:a:] -> [:b:]---  head, last, tail, init,   -- it's not wise to use them on arrays-  nullP,                -- :: [:a:] -> Bool-  lengthP,              -- :: [:a:] -> Int-  (!:),                 -- :: [:a:] -> Int -> a-  foldlP,               -- :: (a -> b -> a) -> a -> [:b:] -> a-  foldl1P,              -- :: (a -> a -> a) ->      [:a:] -> a-  scanlP,               -- :: (a -> b -> a) -> a -> [:b:] -> [:a:]-  scanl1P,              -- :: (a -> a -> a) ->      [:a:] -> [:a:]-  foldrP,               -- :: (a -> b -> b) -> b -> [:a:] -> b-  foldr1P,              -- :: (a -> a -> a) ->      [:a:] -> a-  scanrP,               -- :: (a -> b -> b) -> b -> [:a:] -> [:b:]-  scanr1P,              -- :: (a -> a -> a) ->      [:a:] -> [:a:]---  iterate, repeat,          -- parallel arrays must be finite-  singletonP,           -- :: a -> [:a:]-  emptyP,               -- :: [:a:]-  replicateP,           -- :: Int -> a -> [:a:]---  cycle,                    -- parallel arrays must be finite-  takeP,                -- :: Int -> [:a:] -> [:a:]-  dropP,                -- :: Int -> [:a:] -> [:a:]-  splitAtP,             -- :: Int -> [:a:] -> ([:a:],[:a:])-  takeWhileP,           -- :: (a -> Bool) -> [:a:] -> [:a:]-  dropWhileP,           -- :: (a -> Bool) -> [:a:] -> [:a:]-  spanP,                -- :: (a -> Bool) -> [:a:] -> ([:a:], [:a:])-  breakP,               -- :: (a -> Bool) -> [:a:] -> ([:a:], [:a:])---  lines, words, unlines, unwords,  -- is string processing really needed-  reverseP,             -- :: [:a:] -> [:a:]-  andP,                 -- :: [:Bool:] -> Bool-  orP,                  -- :: [:Bool:] -> Bool-  anyP,                 -- :: (a -> Bool) -> [:a:] -> Bool-  allP,                 -- :: (a -> Bool) -> [:a:] -> Bool-  elemP,                -- :: (Eq a) => a -> [:a:] -> Bool-  notElemP,             -- :: (Eq a) => a -> [:a:] -> Bool-  lookupP,              -- :: (Eq a) => a -> [:(a, b):] -> Maybe b-  sumP,                 -- :: (Num a) => [:a:] -> a-  productP,             -- :: (Num a) => [:a:] -> a-  maximumP,             -- :: (Ord a) => [:a:] -> a-  minimumP,             -- :: (Ord a) => [:a:] -> a-  zipP,                 -- :: [:a:] -> [:b:]          -> [:(a, b)   :]-  zip3P,                -- :: [:a:] -> [:b:] -> [:c:] -> [:(a, b, c):]-  zipWithP,             -- :: (a -> b -> c)      -> [:a:] -> [:b:] -> [:c:]-  zipWith3P,            -- :: (a -> b -> c -> d) -> [:a:]->[:b:]->[:c:]->[:d:]-  unzipP,               -- :: [:(a, b)   :] -> ([:a:], [:b:])-  unzip3P,              -- :: [:(a, b, c):] -> ([:a:], [:b:], [:c:])--  -- overloaded functions-  ---  enumFromToP,          -- :: Enum a => a -> a      -> [:a:]-  enumFromThenToP,      -- :: Enum a => a -> a -> a -> [:a:]--  -- the following functions are not available on lists-  ---  toP,                  -- :: [a] -> [:a:]-  fromP,                -- :: [:a:] -> [a]-  sliceP,               -- :: Int -> Int -> [:e:] -> [:e:]-  foldP,                -- :: (e -> e -> e) -> e -> [:e:] -> e-  fold1P,               -- :: (e -> e -> e) ->      [:e:] -> e-  permuteP,             -- :: [:Int:] -> [:e:] ->          [:e:]-  bpermuteP,            -- :: [:Int:] -> [:e:] ->          [:e:]-  dpermuteP,            -- :: [:Int:] -> [:e:] -> [:e:] -> [:e:]-  crossP,               -- :: [:a:] -> [:b:] -> [:(a, b):]-  crossMapP,            -- :: [:a:] -> (a -> [:b:]) -> [:(a, b):]-  indexOfP              -- :: (a -> Bool) -> [:a:] -> [:Int:]-) where--#ifndef __HADDOCK__--import Prelude--import GHC.ST   ( ST(..), runST )-import GHC.Base ( Int#, Array#, Int(I#), MutableArray#, newArray#,-                  unsafeFreezeArray#, indexArray#, writeArray#, (<#), (>=#) )--infixl 9  !:-infixr 5  +:+-infix  4  `elemP`, `notElemP`----- representation of parallel arrays--- ------------------------------------- this rather straight forward implementation maps parallel arrays to the--- internal representation used for standard Haskell arrays in GHC's Prelude--- (EXPORTED ABSTRACTLY)------ * This definition *must* be kept in sync with `TysWiredIn.parrTyCon'!----data [::] e = PArr Int# (Array# e)----- exported operations on parallel arrays--- ------------------------------------------ operations corresponding to list operations-----mapP   :: (a -> b) -> [:a:] -> [:b:]-mapP f  = fst . loop (mapEFL f) noAL--(+:+)     :: [:a:] -> [:a:] -> [:a:]-a1 +:+ a2  = fst $ loop (mapEFL sel) noAL (enumFromToP 0 (len1 + len2 - 1))-                       -- we can't use the [:x..y:] form here for tedious-                       -- reasons to do with the typechecker and the fact that-                       -- `enumFromToP' is defined in the same module-             where-               len1 = lengthP a1-               len2 = lengthP a2-               ---               sel i | i < len1  = a1!:i-                     | otherwise = a2!:(i - len1)--filterP   :: (a -> Bool) -> [:a:] -> [:a:]-filterP p  = fst . loop (filterEFL p) noAL--concatP     :: [:[:a:]:] -> [:a:]-concatP xss  = foldlP (+:+) [::] xss--concatMapP   :: (a -> [:b:]) -> [:a:] -> [:b:]-concatMapP f  = concatP . mapP f----  head, last, tail, init,   -- it's not wise to use them on arrays--nullP      :: [:a:] -> Bool-nullP [::]  = True-nullP _     = False--lengthP             :: [:a:] -> Int-lengthP (PArr n# _)  = I# n#--(!:) :: [:a:] -> Int -> a-(!:)  = indexPArr--foldlP     :: (a -> b -> a) -> a -> [:b:] -> a-foldlP f z  = snd . loop (foldEFL (flip f)) z--foldl1P        :: (a -> a -> a) -> [:a:] -> a-foldl1P _ [::]  = error "Prelude.foldl1P: empty array"-foldl1P f a     = snd $ loopFromTo 1 (lengthP a - 1) (foldEFL f) (a!:0) a--scanlP     :: (a -> b -> a) -> a -> [:b:] -> [:a:]-scanlP f z  = fst . loop (scanEFL (flip f)) z--scanl1P        :: (a -> a -> a) -> [:a:] -> [:a:]-scanl1P _ [::]  = error "Prelude.scanl1P: empty array"-scanl1P f a     = fst $ loopFromTo 1 (lengthP a - 1) (scanEFL f) (a!:0) a--foldrP :: (a -> b -> b) -> b -> [:a:] -> b-foldrP  = error "Prelude.foldrP: not implemented yet" -- FIXME--foldr1P :: (a -> a -> a) -> [:a:] -> a-foldr1P  = error "Prelude.foldr1P: not implemented yet" -- FIXME--scanrP :: (a -> b -> b) -> b -> [:a:] -> [:b:]-scanrP  = error "Prelude.scanrP: not implemented yet" -- FIXME--scanr1P :: (a -> a -> a) -> [:a:] -> [:a:]-scanr1P  = error "Prelude.scanr1P: not implemented yet" -- FIXME----  iterate, repeat           -- parallel arrays must be finite--singletonP             :: a -> [:a:]-{-# INLINE singletonP #-}-singletonP e = replicateP 1 e-  -emptyP:: [:a:]-{- NOINLINE emptyP #-}-emptyP = replicateP 0 undefined---replicateP             :: Int -> a -> [:a:]-{-# INLINE replicateP #-}-replicateP n e  = runST (do-  marr# <- newArray n e-  mkPArr n marr#)----  cycle                     -- parallel arrays must be finite--takeP   :: Int -> [:a:] -> [:a:]-takeP n  = sliceP 0 (n - 1)--dropP     :: Int -> [:a:] -> [:a:]-dropP n a  = sliceP n (lengthP a - 1) a--splitAtP      :: Int -> [:a:] -> ([:a:],[:a:])-splitAtP n xs  = (takeP n xs, dropP n xs)--takeWhileP :: (a -> Bool) -> [:a:] -> [:a:]-takeWhileP  = error "Prelude.takeWhileP: not implemented yet" -- FIXME--dropWhileP :: (a -> Bool) -> [:a:] -> [:a:]-dropWhileP  = error "Prelude.dropWhileP: not implemented yet" -- FIXME--spanP :: (a -> Bool) -> [:a:] -> ([:a:], [:a:])-spanP  = error "Prelude.spanP: not implemented yet" -- FIXME--breakP   :: (a -> Bool) -> [:a:] -> ([:a:], [:a:])-breakP p  = spanP (not . p)----  lines, words, unlines, unwords,  -- is string processing really needed--reverseP   :: [:a:] -> [:a:]-reverseP a  = permuteP (enumFromThenToP (len - 1) (len - 2) 0) a-                       -- we can't use the [:x, y..z:] form here for tedious-                       -- reasons to do with the typechecker and the fact that-                       -- `enumFromThenToP' is defined in the same module-              where-                len = lengthP a--andP :: [:Bool:] -> Bool-andP  = foldP (&&) True--orP :: [:Bool:] -> Bool-orP  = foldP (||) True--anyP   :: (a -> Bool) -> [:a:] -> Bool-anyP p  = orP . mapP p--allP :: (a -> Bool) -> [:a:] -> Bool-allP p  = andP . mapP p--elemP   :: (Eq a) => a -> [:a:] -> Bool-elemP x  = anyP (== x)--notElemP   :: (Eq a) => a -> [:a:] -> Bool-notElemP x  = allP (/= x)--lookupP :: (Eq a) => a -> [:(a, b):] -> Maybe b-lookupP  = error "Prelude.lookupP: not implemented yet" -- FIXME--sumP :: (Num a) => [:a:] -> a-sumP  = foldP (+) 0--productP :: (Num a) => [:a:] -> a-productP  = foldP (*) 1--maximumP      :: (Ord a) => [:a:] -> a-maximumP [::]  = error "Prelude.maximumP: empty parallel array"-maximumP xs    = fold1P max xs--minimumP :: (Ord a) => [:a:] -> a-minimumP [::]  = error "Prelude.minimumP: empty parallel array"-minimumP xs    = fold1P min xs--zipP :: [:a:] -> [:b:] -> [:(a, b):]-zipP  = zipWithP (,)--zip3P :: [:a:] -> [:b:] -> [:c:] -> [:(a, b, c):]-zip3P  = zipWith3P (,,)--zipWithP         :: (a -> b -> c) -> [:a:] -> [:b:] -> [:c:]-zipWithP f a1 a2  = let -                      len1 = lengthP a1-                      len2 = lengthP a2-                      len  = len1 `min` len2-                    in-                    fst $ loopFromTo 0 (len - 1) combine 0 a1-                    where-                      combine e1 i = (Just $ f e1 (a2!:i), i + 1)--zipWith3P :: (a -> b -> c -> d) -> [:a:]->[:b:]->[:c:]->[:d:]-zipWith3P f a1 a2 a3 = let -                        len1 = lengthP a1-                        len2 = lengthP a2-                        len3 = lengthP a3-                        len  = len1 `min` len2 `min` len3-                      in-                      fst $ loopFromTo 0 (len - 1) combine 0 a1-                      where-                        combine e1 i = (Just $ f e1 (a2!:i) (a3!:i), i + 1)--unzipP   :: [:(a, b):] -> ([:a:], [:b:])-unzipP a  = (fst $ loop (mapEFL fst) noAL a, fst $ loop (mapEFL snd) noAL a)--- FIXME: these two functions should be optimised using a tupled custom loop-unzip3P   :: [:(a, b, c):] -> ([:a:], [:b:], [:c:])-unzip3P x  = (fst $ loop (mapEFL fst3) noAL x, -              fst $ loop (mapEFL snd3) noAL x,-              fst $ loop (mapEFL trd3) noAL x)-             where-               fst3 (a, _, _) = a-               snd3 (_, b, _) = b-               trd3 (_, _, c) = c---- instances-----instance Eq a => Eq [:a:] where-  a1 == a2 | lengthP a1 == lengthP a2 = andP (zipWithP (==) a1 a2)-           | otherwise                = False--instance Ord a => Ord [:a:] where-  compare a1 a2 = case foldlP combineOrdering EQ (zipWithP compare a1 a2) of-                    EQ | lengthP a1 == lengthP a2 -> EQ-                       | lengthP a1 <  lengthP a2 -> LT-                       | otherwise                -> GT-                  where-                    combineOrdering EQ    EQ    = EQ-                    combineOrdering EQ    other = other-                    combineOrdering other _     = other--instance Functor [::] where-  fmap = mapP--instance Monad [::] where-  m >>= k  = foldrP ((+:+) . k      ) [::] m-  m >>  k  = foldrP ((+:+) . const k) [::] m-  return x = [:x:]-  fail _   = [::]--instance Show a => Show [:a:]  where-  showsPrec _  = showPArr . fromP-    where-      showPArr []     s = "[::]" ++ s-      showPArr (x:xs) s = "[:" ++ shows x (showPArr' xs s)--      showPArr' []     s = ":]" ++ s-      showPArr' (y:ys) s = ',' : shows y (showPArr' ys s)--instance Read a => Read [:a:]  where-  readsPrec _ a = [(toP v, rest) | (v, rest) <- readPArr a]-    where-      readPArr = readParen False (\r -> do-                                          ("[:",s) <- lex r-                                          readPArr1 s)-      readPArr1 s = -        (do { (":]", t) <- lex s; return ([], t) }) ++-        (do { (x, t) <- reads s; (xs, u) <- readPArr2 t; return (x:xs, u) })--      readPArr2 s = -        (do { (":]", t) <- lex s; return ([], t) }) ++-        (do { (",", t) <- lex s; (x, u) <- reads t; (xs, v) <- readPArr2 u; -              return (x:xs, v) })---- overloaded functions--- ---- Ideally, we would like `enumFromToP' and `enumFromThenToP' to be members of--- `Enum'.  On the other hand, we really do not want to change `Enum'.  Thus,--- for the moment, we hope that the compiler is sufficiently clever to--- properly fuse the following definitions.--enumFromToP     :: Enum a => a -> a -> [:a:]-enumFromToP x0 y0  = mapP toEnum (eftInt (fromEnum x0) (fromEnum y0))-  where-    eftInt x y = scanlP (+) x $ replicateP (y - x + 1) 1--enumFromThenToP       :: Enum a => a -> a -> a -> [:a:]-enumFromThenToP x0 y0 z0  = -  mapP toEnum (efttInt (fromEnum x0) (fromEnum y0) (fromEnum z0))-  where-    efttInt x y z = scanlP (+) x $ -                      replicateP (abs (z - x) `div` abs delta + 1) delta-      where-       delta = y - x---- the following functions are not available on lists------- create an array from a list (EXPORTED)----toP   :: [a] -> [:a:]-toP l  = fst $ loop store l (replicateP (length l) ())-         where-           store _ (x:xs) = (Just x, xs)---- convert an array to a list (EXPORTED)----fromP   :: [:a:] -> [a]-fromP a  = [a!:i | i <- [0..lengthP a - 1]]---- cut a subarray out of an array (EXPORTED)----sliceP :: Int -> Int -> [:e:] -> [:e:]-sliceP from to a = -  fst $ loopFromTo (0 `max` from) (to `min` (lengthP a - 1)) (mapEFL id) noAL a---- parallel folding (EXPORTED)------ * the first argument must be associative; otherwise, the result is undefined----foldP :: (e -> e -> e) -> e -> [:e:] -> e-foldP  = foldlP---- parallel folding without explicit neutral (EXPORTED)------ * the first argument must be associative; otherwise, the result is undefined----fold1P :: (e -> e -> e) -> [:e:] -> e-fold1P  = foldl1P---- permute an array according to the permutation vector in the first argument--- (EXPORTED)----permuteP       :: [:Int:] -> [:e:] -> [:e:]-permuteP is es -  | isLen /= esLen = error "GHC.PArr: arguments must be of the same length"-  | otherwise      = runST (do-                       marr <- newArray isLen noElem-                       permute marr is es-                       mkPArr isLen marr)-  where-    noElem = error "GHC.PArr.permuteP: I do not exist!"-             -- unlike standard Haskell arrays, this value represents an-             -- internal error-    isLen = lengthP is-    esLen = lengthP es---- permute an array according to the back-permutation vector in the first--- argument (EXPORTED)------ * the permutation vector must represent a surjective function; otherwise,---   the result is undefined----bpermuteP       :: [:Int:] -> [:e:] -> [:e:]-bpermuteP is es  = fst $ loop (mapEFL (es!:)) noAL is---- permute an array according to the permutation vector in the first--- argument, which need not be surjective (EXPORTED)------ * any elements in the result that are not covered by the permutation---   vector assume the value of the corresponding position of the third---   argument ----dpermuteP :: [:Int:] -> [:e:] -> [:e:] -> [:e:]-dpermuteP is es dft-  | 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-                       permute marr is es-                       mkPArr dftLen marr)-  where-    noElem = error "GHC.PArr.permuteP: I do not exist!"-             -- unlike standard Haskell arrays, this value represents an-             -- internal error-    isLen  = lengthP is-    esLen  = lengthP es-    dftLen = lengthP dft--    copyOne e _ = (Just e, noAL)---- computes the cross combination of two arrays (EXPORTED)----crossP       :: [:a:] -> [:b:] -> [:(a, b):]-crossP a1 a2  = fst $ loop combine (0, 0) $ replicateP len ()-                where-                  len1 = lengthP a1-                  len2 = lengthP a2-                  len  = len1 * len2-                  ---                  combine _ (i, j) = (Just $ (a1!:i, a2!:j), next)-                                     where-                                       next | (i + 1) == len1 = (0    , j + 1)-                                            | otherwise       = (i + 1, j)--{- An alternative implementation-   * The one above is certainly better for flattened code, but here where we-     are handling boxed arrays, the trade off is less clear.  However, I-     think, the above one is still better.--crossP a1 a2  = let-                  len1 = lengthP a1-                  len2 = lengthP a2-                  x1   = concatP $ mapP (replicateP len2) a1-                  x2   = concatP $ replicateP len1 a2-                in-                zipP x1 x2- -}---- |Compute a cross of an array and the arrays produced by the given function--- for the elements of the first array.----crossMapP :: [:a:] -> (a -> [:b:]) -> [:(a, b):]-crossMapP a f = let-                  bs   = mapP f a-                  segd = mapP lengthP bs-                  as   = zipWithP replicateP segd a-                in-                zipP (concatP as) (concatP bs)--{- The following may seem more straight forward, but the above is very cheap-   with segmented arrays, as `mapP lengthP', `zipP', and `concatP' are-   constant time, and `map f' uses the lifted version of `f'.--crossMapP a f = concatP $ mapP (\x -> mapP ((,) x) (f x)) a-- -}---- computes an index array for all elements of the second argument for which--- the predicate yields `True' (EXPORTED)----indexOfP     :: (a -> Bool) -> [:a:] -> [:Int:]-indexOfP p a  = fst $ loop calcIdx 0 a-                where-                  calcIdx e idx | p e       = (Just idx, idx + 1)-                                | otherwise = (Nothing , idx    )----- auxiliary functions--- ----------------------- internally used mutable boxed arrays----data MPArr s e = MPArr Int# (MutableArray# s e)---- allocate a new mutable array that is pre-initialised with a given value----newArray             :: Int -> e -> ST s (MPArr s e)-{-# INLINE newArray #-}-newArray (I# n#) e  = ST $ \s1# ->-  case newArray# n# e s1# of { (# s2#, marr# #) ->-  (# s2#, MPArr n# marr# #)}---- convert a mutable array into the external parallel array representation----mkPArr                           :: Int -> MPArr s e -> ST s [:e:]-{-# INLINE mkPArr #-}-mkPArr (I# n#) (MPArr _ marr#)  = ST $ \s1# ->-  case unsafeFreezeArray# marr# s1#   of { (# s2#, arr# #) ->-  (# s2#, PArr n# arr# #) }---- general array iterator------ * corresponds to `loopA' from ``Functional Array Fusion'', Chakravarty &---   Keller, ICFP 2001----loop :: (e -> acc -> (Maybe e', acc))    -- mapping & folding, once per element-     -> acc                              -- initial acc value-     -> [:e:]                            -- input array-     -> ([:e':], acc)-{-# INLINE loop #-}-loop mf acc arr = loopFromTo 0 (lengthP arr - 1) mf acc arr---- general array iterator with bounds----loopFromTo :: Int                        -- from index-           -> Int                        -- to index-           -> (e -> acc -> (Maybe e', acc))-           -> acc-           -> [:e:]-           -> ([:e':], acc)-{-# INLINE loopFromTo #-}-loopFromTo from to mf start arr = runST (do-  marr      <- newArray (to - from + 1) noElem-  (n', acc) <- trans from to marr arr mf start-  arr'      <- mkPArr n' marr-  return (arr', acc))-  where-    noElem = error "GHC.PArr.loopFromTo: I do not exist!"-             -- unlike standard Haskell arrays, this value represents an-             -- internal error---- actual loop body of `loop'------ * for this to be really efficient, it has to be translated with the---   constructor specialisation phase "SpecConstr" switched on; as of GHC 5.03---   this requires an optimisation level of at least -O2----trans :: Int                            -- index of first elem to process-      -> Int                            -- index of last elem to process-      -> MPArr s e'                     -- destination array-      -> [:e:]                          -- source array-      -> (e -> acc -> (Maybe e', acc))  -- mutator-      -> acc                            -- initial accumulator-      -> ST s (Int, acc)                -- final destination length/final acc-{-# INLINE trans #-}-trans from to marr arr mf start = trans' from 0 start-  where-    trans' arrOff marrOff acc -      | arrOff > to = return (marrOff, acc)-      | otherwise   = do-                        let (oe', acc') = mf (arr `indexPArr` arrOff) acc-                        marrOff' <- case oe' of-                                      Nothing -> return marrOff -                                      Just e' -> do-                                        writeMPArr marr marrOff e'-                                        return $ marrOff + 1-                        trans' (arrOff + 1) marrOff' acc'---- Permute the given elements into the mutable array.----permute :: MPArr s e -> [:Int:] -> [:e:] -> ST s ()-permute marr is es = perm 0-  where-    perm i-      | i == n = return ()-      | otherwise  = writeMPArr marr (is!:i) (es!:i) >> perm (i + 1)-      where-        n = lengthP is----- common patterns for using `loop'------- initial value for the accumulator when the accumulator is not needed----noAL :: ()-noAL  = ()---- `loop' mutator maps a function over array elements----mapEFL   :: (e -> e') -> (e -> () -> (Maybe e', ()))-{-# INLINE mapEFL #-}-mapEFL f  = \e _ -> (Just $ f e, ())---- `loop' mutator that filter elements according to a predicate----filterEFL   :: (e -> Bool) -> (e -> () -> (Maybe e, ()))-{-# INLINE filterEFL #-}-filterEFL p  = \e _ -> if p e then (Just e, ()) else (Nothing, ())---- `loop' mutator for array folding----foldEFL   :: (e -> acc -> acc) -> (e -> acc -> (Maybe (), acc))-{-# INLINE foldEFL #-}-foldEFL f  = \e a -> (Nothing, f e a)+-- #hide+module GHC.PArr where --- `loop' mutator for array scanning----scanEFL   :: (e -> acc -> acc) -> (e -> acc -> (Maybe acc, acc))-{-# INLINE scanEFL #-}-scanEFL f  = \e a -> (Just a, f e a)+import GHC.Base --- elementary array operations+-- Representation of parallel arrays ------ unlifted array indexing +-- Vanilla representation of parallel Haskell based on standard GHC arrays that is used if the+-- vectorised is /not/ used. ---indexPArr                       :: [:e:] -> Int -> e-{-# INLINE indexPArr #-}-indexPArr (PArr n# arr#) (I# i#) -  | i# >=# 0# && i# <# n# =-    case indexArray# arr# i# of (# e #) -> e-  | otherwise = error $ "indexPArr: out of bounds parallel array index; " ++-                        "idx = " ++ show (I# i#) ++ ", arr len = "-                        ++ show (I# n#)---- encapsulate writing into a mutable array into the `ST' monad+-- NB: This definition *must* be kept in sync with `TysWiredIn.parrTyCon'! ---writeMPArr                           :: MPArr s e -> Int -> e -> ST s ()-{-# INLINE writeMPArr #-}-writeMPArr (MPArr n# marr#) (I# i#) e -  | i# >=# 0# && i# <# n# =-    ST $ \s# ->-    case writeArray# marr# i# e s# of s'# -> (# s'#, () #)-  | otherwise = error $ "writeMPArr: out of bounds parallel array index; " ++-                        "idx = " ++ show (I# i#) ++ ", arr len = "-                        ++ show (I# n#)--#endif /* __HADDOCK__ */-+data [::] e = PArr !Int (Array# e)
GHC/Pack.lhs view
@@ -1,6 +1,7 @@ \begin{code}-{-# OPTIONS_GHC -XNoImplicitPrelude #-}+{-# LANGUAGE NoImplicitPrelude, MagicHash, UnboxedTuples #-} {-# OPTIONS_HADDOCK hide #-}+ ----------------------------------------------------------------------------- -- | -- Module      :  GHC.Pack
GHC/Ptr.lhs view
@@ -1,6 +1,7 @@ \begin{code}-{-# OPTIONS_GHC -XNoImplicitPrelude #-}+{-# LANGUAGE CPP, NoImplicitPrelude, MagicHash #-} {-# OPTIONS_HADDOCK hide #-}+ ----------------------------------------------------------------------------- -- | -- Module      :  GHC.Ptr@@ -16,8 +17,15 @@ -----------------------------------------------------------------------------  -- #hide-module GHC.Ptr where+module GHC.Ptr (+        Ptr(..), FunPtr(..),+        nullPtr, castPtr, plusPtr, alignPtr, minusPtr,+        nullFunPtr, castFunPtr, +        -- * Unsafe functions+        castFunPtrToPtr, castPtrToFunPtr+    ) where+ import GHC.Base import GHC.Show import GHC.Num@@ -155,5 +163,5 @@  instance Show (FunPtr a) where    showsPrec p = showsPrec p . castFunPtrToPtr-\end{code} +\end{code}
GHC/Read.lhs view
@@ -1,6 +1,8 @@ \begin{code}-{-# OPTIONS_GHC -XNoImplicitPrelude #-}+{-# LANGUAGE Trustworthy #-}+{-# LANGUAGE CPP, NoImplicitPrelude, StandaloneDeriving #-} {-# OPTIONS_HADDOCK hide #-}+ ----------------------------------------------------------------------------- -- | -- Module      :  GHC.Read@@ -71,6 +73,8 @@ import GHC.Show import GHC.Base import GHC.Arr+-- For defining instances for the generic deriving mechanism+import GHC.Generics (Arity(..), Associativity(..), Fixity(..)) \end{code}  @@ -679,3 +683,10 @@ readp = readPrec_to_P readPrec minPrec \end{code} +Instances for types of the generic deriving mechanism.++\begin{code}+deriving instance Read Arity+deriving instance Read Associativity+deriving instance Read Fixity+\end{code}
GHC/Real.lhs view
@@ -1,5 +1,6 @@ \begin{code}-{-# OPTIONS_GHC -XNoImplicitPrelude #-}+{-# LANGUAGE Trustworthy #-}+{-# LANGUAGE CPP, NoImplicitPrelude, MagicHash, UnboxedTuples #-} {-# OPTIONS_HADDOCK hide #-} ----------------------------------------------------------------------------- -- |@@ -43,7 +44,7 @@  \begin{code} -- | Rational numbers, with numerator and denominator of some 'Integral' type.-data  (Integral a)      => Ratio a = !a :% !a  deriving (Eq)+data  Ratio a = !a :% !a  deriving (Eq)  -- | Arbitrary-precision rational numbers, represented as a ratio of -- two 'Integer' values.  A rational number may be constructed using@@ -245,32 +246,42 @@      a `quot` b      | b == 0                     = divZeroError-     | a == minBound && b == (-1) = overflowError+     | b == (-1) && a == minBound = overflowError -- Note [Order of tests]+                                                  -- in GHC.Int      | otherwise                  =  a `quotInt` b      a `rem` b      | b == 0                     = divZeroError-     | a == minBound && b == (-1) = overflowError+       -- The quotRem CPU instruction fails for minBound `quotRem` -1,+       -- but minBound `rem` -1 is well-defined (0). We therefore+       -- special-case it.+     | b == (-1)                  = 0      | otherwise                  =  a `remInt` b      a `div` b      | b == 0                     = divZeroError-     | a == minBound && b == (-1) = overflowError+     | b == (-1) && a == minBound = overflowError -- Note [Order of tests]+                                                  -- in GHC.Int      | otherwise                  =  a `divInt` b      a `mod` b      | b == 0                     = divZeroError-     | a == minBound && b == (-1) = overflowError+       -- The divMod CPU instruction fails for minBound `divMod` -1,+       -- but minBound `mod` -1 is well-defined (0). We therefore+       -- special-case it.+     | b == (-1)                  = 0      | otherwise                  =  a `modInt` b      a `quotRem` b      | b == 0                     = divZeroError-     | a == minBound && b == (-1) = overflowError+       -- Note [Order of tests] in GHC.Int+     | b == (-1) && a == minBound = (overflowError, 0)      | otherwise                  =  a `quotRemInt` b      a `divMod` b      | b == 0                     = divZeroError-     | a == minBound && b == (-1) = overflowError+       -- Note [Order of tests] in GHC.Int+     | b == (-1) && a == minBound = (overflowError, 0)      | otherwise                  =  a `divModInt` b \end{code} @@ -514,11 +525,16 @@                   in if even e then (nn :% dd) else (negate nn :% dd)  ---------------------------------------------------------- | @'gcd' x y@ is the greatest (positive) integer that divides both @x@--- and @y@; for example @'gcd' (-3) 6@ = @3@, @'gcd' (-3) (-6)@ = @3@,--- @'gcd' 0 4@ = @4@.  @'gcd' 0 0@ raises a runtime error.+-- | @'gcd' x y@ is the non-negative factor of both @x@ and @y@ of which+-- every common factor of @x@ and @y@ is also a factor; for example+-- @'gcd' 4 2 = 2@, @'gcd' (-4) 6 = 2@, @'gcd' 0 4@ = @4@. @'gcd' 0 0@ = @0@.+-- (That is, the common divisor that is \"greatest\" in the divisibility+-- preordering.)+--+-- Note: Since for signed fixed-width integer types, @'abs' 'minBound' < 0@,+-- the result may be negative if one of the arguments is @'minBound'@ (and+-- necessarily is if the other is @0@ or @'minBound'@) for such types. gcd             :: (Integral a) => a -> a -> a-gcd 0 0         =  error "Prelude.gcd: gcd 0 0 is undefined" gcd x y         =  gcd' (abs x) (abs y)                    where gcd' a 0  =  a                          gcd' a b  =  gcd' b (a `rem` b)@@ -533,16 +549,11 @@ #ifdef OPTIMISE_INTEGER_GCD_LCM {-# RULES "gcd/Int->Int->Int"             gcd = gcdInt-"gcd/Integer->Integer->Integer" gcd = gcdInteger'+"gcd/Integer->Integer->Integer" gcd = gcdInteger "lcm/Integer->Integer->Integer" lcm = lcmInteger  #-} -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
GHC/ST.lhs view
@@ -1,5 +1,5 @@ \begin{code}-{-# OPTIONS_GHC -XNoImplicitPrelude #-}+{-# LANGUAGE NoImplicitPrelude, MagicHash, UnboxedTuples, Rank2Types #-} {-# OPTIONS_HADDOCK hide #-} ----------------------------------------------------------------------------- -- |@@ -16,10 +16,17 @@ -----------------------------------------------------------------------------  -- #hide-module GHC.ST where+module GHC.ST (+        ST(..), STret(..), STRep,+        fixST, runST, runSTRep, +        -- * Unsafe functions+        liftST, unsafeInterleaveST+    ) where+ import GHC.Base import GHC.Show+import Control.Monad( forever )  default () \end{code}@@ -73,6 +80,9 @@         (k2 new_s) }})  data STret s a = STret (State# s) a++{-# SPECIALISE forever :: ST s a -> ST s b #-}+-- See Note [Make forever INLINABLE] in Control.Monad  -- liftST is useful when we want a lifted result from an ST computation.  See -- fixST below.
GHC/STRef.lhs view
@@ -1,12 +1,13 @@ \begin{code}-{-# OPTIONS_GHC -XNoImplicitPrelude #-}+{-# LANGUAGE NoImplicitPrelude, MagicHash, UnboxedTuples #-} {-# OPTIONS_HADDOCK hide #-}+ ----------------------------------------------------------------------------- -- | -- Module      :  GHC.STRef -- 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)@@ -16,7 +17,10 @@ -----------------------------------------------------------------------------  -- #hide-module GHC.STRef where+module GHC.STRef (+        STRef(..),+        newSTRef, readSTRef, writeSTRef+    ) where  import GHC.ST import GHC.Base@@ -44,4 +48,5 @@ -- Just pointer equality on mutable references: instance Eq (STRef s a) where     STRef v1# == STRef v2# = sameMutVar# v1# v2#+ \end{code}
GHC/Show.lhs view
@@ -1,6 +1,8 @@ \begin{code}-{-# OPTIONS_GHC -XNoImplicitPrelude #-}+{-# LANGUAGE Trustworthy #-}+{-# LANGUAGE NoImplicitPrelude, BangPatterns, MagicHash, StandaloneDeriving #-} {-# OPTIONS_HADDOCK hide #-}+ ----------------------------------------------------------------------------- -- | -- Module      :  GHC.Show@@ -23,8 +25,9 @@         -- Instances for Show: (), [], Bool, Ordering, Int, Char          -- Show support code-        shows, showChar, showString, showParen, showList__, showSpace,-        showLitChar, protectEsc,+        shows, showChar, showString, showMultiLineString,+        showParen, showList__, showSpace,+        showLitChar, showLitString, protectEsc,         intToDigit, showSignedInt,         appPrec, appPrec1, @@ -35,7 +38,9 @@  import GHC.Base import Data.Maybe-import GHC.List ((!!), foldr1)+import GHC.List ((!!), foldr1, break)+-- For defining instances for the generic deriving mechanism+import GHC.Generics (Arity(..), Associativity(..), Fixity(..)) \end{code}  @@ -180,14 +185,7 @@     showsPrec _ '\'' = showString "'\\''"     showsPrec _ c    = showChar '\'' . showLitChar c . showChar '\'' -    showList cs = showChar '"' . showl cs-                 where showl ""       s = showChar '"' s-                       showl ('"':xs) s = showString "\\\"" (showl xs s)-                       showl (x:xs)   s = showLitChar x (showl xs s)-                -- Making 's' an explicit parameter makes it clear to GHC-                -- that showl has arity 2, which avoids it allocating an extra lambda-                -- The sticking point is the recursive call to (showl xs), which-                -- it can't figure out would be ok with arity 2.+    showList cs = showChar '"' . showLitString cs . showChar '"'  instance Show Int where     showsPrec = showSignedInt@@ -347,6 +345,35 @@         -- I've done manual eta-expansion here, becuase otherwise it's         -- impossible to stop (asciiTab!!ord) getting floated out as an MFE +showLitString :: String -> ShowS+-- | Same as 'showLitChar', but for strings+-- It converts the string to a string using Haskell escape conventions+-- for non-printable characters. Does not add double-quotes around the+-- whole thing; the caller should do that.+-- The main difference from showLitChar (apart from the fact that the+-- argument is a string not a list) is that we must escape double-quotes +showLitString []         s = s+showLitString ('"' : cs) s = showString "\\\"" (showLitString cs s)+showLitString (c   : cs) s = showLitChar c (showLitString cs s)+   -- Making 's' an explicit parameter makes it clear to GHC that+   -- showLitString has arity 2, which avoids it allocating an extra lambda+   -- The sticking point is the recursive call to (showLitString cs), which+   -- it can't figure out would be ok with arity 2.++showMultiLineString :: String -> [String]+-- | Like 'showLitString' (expand escape characters using Haskell+-- escape conventions), but+--   * break the string into multiple lines+--   * wrap the entire thing in double quotes+-- Example:  @showLitString "hello\ngoodbye\nblah"@+-- returns   @["\"hello\\", "\\goodbye\\", "\\blah\""]@+showMultiLineString str+  = go '\"' str+  where+    go ch s = case break (== '\n') s of+                (l, _:s'@(_:_)) -> (ch : showLitString l "\\") : go '\\' s'+                (l, _)          -> [ch : showLitString l "\""]+ isDec :: Char -> Bool isDec c = c >= '0' && c <= '9' @@ -401,4 +428,12 @@         | x# <# 10#  = C# (chr# (ord# '0'# +# x#)) : cs'         | otherwise = case chr# (ord# '0'# +# (x# `remInt#` 10#)) of { c# ->                       itos' (x# `quotInt#` 10#) (C# c# : cs') }+\end{code}++Instances for types of the generic deriving mechanism.++\begin{code}+deriving instance Show Arity+deriving instance Show Associativity+deriving instance Show Fixity \end{code}
GHC/Show.lhs-boot view
@@ -1,5 +1,6 @@ \begin{code}-{-# OPTIONS_GHC -XNoImplicitPrelude #-}+{-# LANGUAGE Trustworthy #-}+{-# LANGUAGE NoImplicitPrelude #-}  module GHC.Show (showSignedInt) where
GHC/Stable.lhs view
@@ -1,6 +1,11 @@ \begin{code}-{-# OPTIONS_GHC -XNoImplicitPrelude #-}+{-# LANGUAGE NoImplicitPrelude+           , MagicHash+           , UnboxedTuples+           , ForeignFunctionInterface+  #-} {-# OPTIONS_HADDOCK hide #-}+ ----------------------------------------------------------------------------- -- | -- Module      :  GHC.Stable@@ -16,18 +21,17 @@ -----------------------------------------------------------------------------  -- #hide-module GHC.Stable -        ( StablePtr(..)-        , newStablePtr          -- :: a -> IO (StablePtr a)    -        , deRefStablePtr        -- :: StablePtr a -> a-        , freeStablePtr         -- :: StablePtr a -> IO ()-        , castStablePtrToPtr    -- :: StablePtr a -> Ptr ()-        , castPtrToStablePtr    -- :: Ptr () -> StablePtr a-   ) where+module GHC.Stable (+        StablePtr(..),+        newStablePtr,         -- :: a -> IO (StablePtr a)    +        deRefStablePtr,       -- :: StablePtr a -> a+        freeStablePtr,        -- :: StablePtr a -> IO ()+        castStablePtrToPtr,   -- :: StablePtr a -> Ptr ()+        castPtrToStablePtr    -- :: Ptr () -> StablePtr a+    ) where  import GHC.Ptr import GHC.Base--- import GHC.IO  ----------------------------------------------------------------------------- -- Stable Pointers@@ -104,4 +108,5 @@         case eqStablePtr# sp1 sp2 of            0# -> False            _  -> True+ \end{code}
GHC/Storable.lhs view
@@ -1,6 +1,8 @@ \begin{code}-{-# OPTIONS_GHC -XNoImplicitPrelude #-}+{-# LANGUAGE Trustworthy #-}+{-# LANGUAGE NoImplicitPrelude, MagicHash, UnboxedTuples #-} {-# OPTIONS_HADDOCK hide #-}+ ----------------------------------------------------------------------------- -- | -- Module      :  GHC.Storable@@ -51,7 +53,7 @@         , writeWord64OffPtr            ) where -import GHC.Stable       ( StablePtr(..) )+import GHC.Stable ( StablePtr(..) ) import GHC.Int import GHC.Word import GHC.Ptr
GHC/TopHandler.lhs view
@@ -1,7 +1,15 @@ \begin{code}-{-# OPTIONS_GHC -XNoImplicitPrelude #-}+{-# LANGUAGE Trustworthy #-}+{-# LANGUAGE CPP+           , NoImplicitPrelude+           , ForeignFunctionInterface+           , MagicHash+           , UnboxedTuples+           , PatternGuards+  #-} {-# OPTIONS_GHC -fno-warn-unused-imports #-} {-# OPTIONS_HADDOCK hide #-}+ ----------------------------------------------------------------------------- -- | -- Module      :  GHC.TopHandler@@ -19,10 +27,10 @@  -- #hide module GHC.TopHandler (-   runMainIO, runIO, runIOFastExit, runNonIO,-   topHandler, topHandlerFastExit,-   reportStackOverflow, reportError,-  ) where+        runMainIO, runIO, runIOFastExit, runNonIO,+        topHandler, topHandlerFastExit,+        reportStackOverflow, reportError,+    ) where  #include "HsBaseConfig.h"
GHC/Unicode.hs view
@@ -1,6 +1,8 @@-{-# OPTIONS_GHC -XNoImplicitPrelude #-}+{-# LANGUAGE Trustworthy #-}+{-# LANGUAGE CPP, NoImplicitPrelude, ForeignFunctionInterface #-} {-# OPTIONS -#include "WCsubst.h" #-} {-# OPTIONS_HADDOCK hide #-}+ ----------------------------------------------------------------------------- -- | -- Module      :  GHC.Unicode@@ -19,14 +21,14 @@  -- #hide module GHC.Unicode (-    isAscii, isLatin1, isControl,-    isAsciiUpper, isAsciiLower,-    isPrint, isSpace,  isUpper,-    isLower, isAlpha,  isDigit,-    isOctDigit, isHexDigit, isAlphaNum,-    toUpper, toLower, toTitle,-    wgencat,-  ) where+        isAscii, isLatin1, isControl,+        isAsciiUpper, isAsciiLower,+        isPrint, isSpace,  isUpper,+        isLower, isAlpha,  isDigit,+        isOctDigit, isHexDigit, isAlphaNum,+        toUpper, toLower, toTitle,+        wgencat+    ) where  import GHC.Base import GHC.Real        (fromIntegral)
GHC/Unicode.hs-boot view
@@ -1,8 +1,8 @@-{-# OPTIONS_GHC -XNoImplicitPrelude #-}+{-# LANGUAGE Trustworthy #-}+{-# LANGUAGE NoImplicitPrelude #-}  module GHC.Unicode where -import GHC.Bool import GHC.Types  isAscii         :: Char -> Bool
GHC/Weak.lhs view
@@ -1,6 +1,14 @@ \begin{code}-{-# OPTIONS_GHC -XNoImplicitPrelude #-}+{-# LANGUAGE CPP+           , NoImplicitPrelude+           , BangPatterns+           , MagicHash+           , UnboxedTuples+           , DeriveDataTypeable+           , StandaloneDeriving+  #-} {-# OPTIONS_HADDOCK hide #-}+ ----------------------------------------------------------------------------- -- | -- Module      :  GHC.Weak@@ -16,7 +24,13 @@ -----------------------------------------------------------------------------  -- #hide-module GHC.Weak where+module GHC.Weak (+        Weak(..),+        mkWeak,+        deRefWeak,+        finalize,+        runFinalizerBatch+    ) where  import GHC.Base import Data.Maybe
+ GHC/Windows.hs view
@@ -0,0 +1,48 @@+{-# LANGUAGE Trustworthy #-}+{-# LANGUAGE NoImplicitPrelude, ForeignFunctionInterface #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  GHC.Windows+-- Copyright   :  (c) The University of Glasgow, 2009+-- License     :  see libraries/base/LICENSE+-- +-- Maintainer  :  libraries@haskell.org+-- Stability   :  internal+-- Portability :  non-portable+--+-- Windows functionality used by several modules.+--+-- ToDo: this just duplicates part of System.Win32.Types, which isn't+-- available yet.  We should move some Win32 functionality down here,+-- maybe as part of the grand reorganisation of the base package...+--+-----------------------------------------------------------------------------++module GHC.Windows (+        HANDLE, DWORD, LPTSTR, iNFINITE,+        throwGetLastError, c_maperrno+    ) where++import GHC.Base+import GHC.Ptr++import Data.Word++import Foreign.C.Error (throwErrno)+import Foreign.C.Types+++type HANDLE       = Ptr ()+type DWORD        = Word32++type LPTSTR = Ptr CWchar++iNFINITE :: DWORD+iNFINITE = 0xFFFFFFFF -- urgh++throwGetLastError :: String -> IO a+throwGetLastError where_from = c_maperrno >> throwErrno where_from++foreign import ccall unsafe "maperrno"             -- in Win32Utils.c+   c_maperrno :: IO ()+
GHC/Word.hs view
@@ -1,5 +1,7 @@-{-# OPTIONS_GHC -XNoImplicitPrelude #-}+{-# LANGUAGE Trustworthy #-}+{-# LANGUAGE CPP, NoImplicitPrelude, BangPatterns, MagicHash #-} {-# OPTIONS_HADDOCK hide #-}+ ----------------------------------------------------------------------------- -- | -- Module      :  GHC.Word
Numeric.hs view
@@ -1,4 +1,6 @@-{-# OPTIONS_GHC -XNoImplicitPrelude #-}+{-# LANGUAGE Trustworthy #-}+{-# LANGUAGE CPP, NoImplicitPrelude, MagicHash #-}+ ----------------------------------------------------------------------------- -- | -- Module      :  Numeric
Prelude.hs view
@@ -1,4 +1,6 @@-{-# OPTIONS_GHC -XNoImplicitPrelude -XBangPatterns #-}+{-# LANGUAGE Trustworthy #-}+{-# LANGUAGE CPP, NoImplicitPrelude, BangPatterns #-}+ ----------------------------------------------------------------------------- -- | -- Module      :  Prelude@@ -155,8 +157,6 @@  #ifdef __GLASGOW_HASKELL__ import GHC.Base--- import GHC.IO--- import GHC.IO.Exception import Text.Read import GHC.Enum import GHC.Num
System/CPUTime.hsc view
@@ -1,3 +1,6 @@+{-# LANGUAGE Trustworthy #-}+{-# LANGUAGE CPP, NondecreasingIndentation, ForeignFunctionInterface #-}+ ----------------------------------------------------------------------------- -- | -- Module      :  System.CPUTime@@ -31,7 +34,7 @@ #endif  #ifdef __GLASGOW_HASKELL__-import Foreign hiding (unsafePerformIO)+import Foreign.Safe import Foreign.C #if !defined(CLK_TCK) import System.IO.Unsafe (unsafePerformIO)@@ -99,9 +102,9 @@     let ru_utime = (#ptr struct rusage, ru_utime) p_rusage     let ru_stime = (#ptr struct rusage, ru_stime) p_rusage     u_sec  <- (#peek struct timeval,tv_sec)  ru_utime :: IO CTime-    u_usec <- (#peek struct timeval,tv_usec) ru_utime :: IO CTime+    u_usec <- (#peek struct timeval,tv_usec) ru_utime :: IO CSUSeconds     s_sec  <- (#peek struct timeval,tv_sec)  ru_stime :: IO CTime-    s_usec <- (#peek struct timeval,tv_usec) ru_stime :: IO CTime+    s_usec <- (#peek struct timeval,tv_usec) ru_stime :: IO CSUSeconds     return ((realToInteger u_sec * 1000000 + realToInteger u_usec +               realToInteger s_sec * 1000000 + realToInteger s_usec)                  * 1000000)
System/Console/GetOpt.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE Safe #-} ----------------------------------------------------------------------------- -- | -- Module      :  System.Console.GetOpt
System/Environment.hs view
@@ -1,3 +1,6 @@+{-# LANGUAGE Safe #-}+{-# LANGUAGE CPP, ForeignFunctionInterface #-}+ ----------------------------------------------------------------------------- -- | -- Module      :  System.Environment@@ -29,14 +32,21 @@ import Prelude  #ifdef __GLASGOW_HASKELL__-import Data.List-import Foreign+import Foreign.Safe import Foreign.C import Control.Exception.Base   ( bracket )-import Control.Monad -- import GHC.IO import GHC.IO.Exception+import GHC.IO.Encoding (fileSystemEncoding)+import qualified GHC.Foreign as GHC+import Data.List+#ifdef mingw32_HOST_OS+import GHC.Environment+import GHC.Windows+#else+import Control.Monad #endif+#endif  #ifdef __HUGS__ import Hugs.System@@ -50,25 +60,78 @@   ) #endif +#ifdef __GLASGOW_HASKELL__ -- --------------------------------------------------------------------------- -- getArgs, getProgName, getEnv +#ifdef mingw32_HOST_OS++-- Ignore the arguments to hs_init on Windows for the sake of Unicode compat++getWin32ProgArgv_certainly :: IO [String]+getWin32ProgArgv_certainly = do+	mb_argv <- getWin32ProgArgv+	case mb_argv of+	  Nothing   -> fmap dropRTSArgs getFullArgs+	  Just argv -> return argv++withWin32ProgArgv :: [String] -> IO a -> IO a+withWin32ProgArgv argv act = bracket begin setWin32ProgArgv (\_ -> act)+  where+    begin = do+	  mb_old_argv <- getWin32ProgArgv+	  setWin32ProgArgv (Just argv)+	  return mb_old_argv++getWin32ProgArgv :: IO (Maybe [String])+getWin32ProgArgv = alloca $ \p_argc -> alloca $ \p_argv -> do+	c_getWin32ProgArgv p_argc p_argv+	argc <- peek p_argc+	argv_p <- peek p_argv+	if argv_p == nullPtr+	 then return Nothing+	 else do+	  argv_ps <- peekArray (fromIntegral argc) argv_p+	  fmap Just $ mapM peekCWString argv_ps++setWin32ProgArgv :: Maybe [String] -> IO ()+setWin32ProgArgv Nothing = c_setWin32ProgArgv 0 nullPtr+setWin32ProgArgv (Just argv) = withMany withCWString argv $ \argv_ps -> withArrayLen argv_ps $ \argc argv_p -> do+	c_setWin32ProgArgv (fromIntegral argc) argv_p++foreign import ccall unsafe "getWin32ProgArgv"+  c_getWin32ProgArgv :: Ptr CInt -> Ptr (Ptr CWString) -> IO ()++foreign import ccall unsafe "setWin32ProgArgv"+  c_setWin32ProgArgv :: CInt -> Ptr CWString -> IO ()++dropRTSArgs :: [String] -> [String]+dropRTSArgs []             = []+dropRTSArgs ("+RTS":rest)  = dropRTSArgs (dropWhile (/= "-RTS") rest)+dropRTSArgs ("--RTS":rest) = rest+dropRTSArgs ("-RTS":rest)  = dropRTSArgs rest+dropRTSArgs (arg:rest)     = arg : dropRTSArgs rest++#endif+ -- | Computation 'getArgs' returns a list of the program's command -- line arguments (not including the program name).--#ifdef __GLASGOW_HASKELL__ getArgs :: IO [String]++#ifdef mingw32_HOST_OS+getArgs =  fmap tail getWin32ProgArgv_certainly+#else getArgs =   alloca $ \ p_argc ->   alloca $ \ p_argv -> do    getProgArgv p_argc p_argv    p    <- fromIntegral `liftM` peek p_argc    argv <- peek p_argv-   peekArray (p - 1) (advancePtr argv 1) >>= mapM peekCString-+   peekArray (p - 1) (advancePtr argv 1) >>= mapM (GHC.peekCString fileSystemEncoding)  foreign import ccall unsafe "getProgArgv"   getProgArgv :: Ptr CInt -> Ptr (Ptr CString) -> IO ()+#endif  {-| Computation 'getProgName' returns the name of the program as it was@@ -81,6 +144,10 @@ is probably really @FOO.EXE@, and that is what 'getProgName' will return. -} getProgName :: IO String+#ifdef mingw32_HOST_OS+-- Ignore the arguments to hs_init on Windows for the sake of Unicode compat+getProgName = fmap (basename . head) getWin32ProgArgv_certainly+#else getProgName =   alloca $ \ p_argc ->   alloca $ \ p_argv -> do@@ -90,23 +157,24 @@  unpackProgName  :: Ptr (Ptr CChar) -> IO String   -- argv[0] unpackProgName argv = do-  s <- peekElemOff argv 0 >>= peekCString+  s <- peekElemOff argv 0 >>= GHC.peekCString fileSystemEncoding   return (basename s)-  where-   basename :: String -> String-   basename f = go f f-    where-      go acc [] = acc-      go acc (x:xs)-        | isPathSeparator x = go xs xs-        | otherwise         = go acc xs+#endif -   isPathSeparator :: Char -> Bool-   isPathSeparator '/'  = True-#ifdef mingw32_HOST_OS -   isPathSeparator '\\' = True+basename :: FilePath -> FilePath+basename f = go f f+ where+  go acc [] = acc+  go acc (x:xs)+    | isPathSeparator x = go xs xs+    | otherwise         = go acc xs++  isPathSeparator :: Char -> Bool+  isPathSeparator '/'  = True+#ifdef mingw32_HOST_OS+  isPathSeparator '\\' = True #endif-   isPathSeparator _    = False+  isPathSeparator _    = False   -- | Computation 'getEnv' @var@ returns the value@@ -118,17 +186,44 @@ --    does not exist.  getEnv :: String -> IO String+#ifdef mingw32_HOST_OS+getEnv name = withCWString name $ \s -> try_size s 256+  where+    try_size s size = allocaArray (fromIntegral size) $ \p_value -> do+      res <- c_GetEnvironmentVariable s p_value size+      case res of+        0 -> do+		  err <- c_GetLastError+		  if err == eRROR_ENVVAR_NOT_FOUND+		   then ioe_missingEnvVar name+		   else throwGetLastError "getEnv"+        _ | res > size -> try_size s res -- Rare: size increased between calls to GetEnvironmentVariable+          | otherwise  -> peekCWString p_value++eRROR_ENVVAR_NOT_FOUND :: DWORD+eRROR_ENVVAR_NOT_FOUND = 203++foreign import stdcall unsafe "windows.h GetLastError"+  c_GetLastError:: IO DWORD++foreign import stdcall unsafe "windows.h GetEnvironmentVariableW"+  c_GetEnvironmentVariable :: LPTSTR -> LPTSTR -> DWORD -> IO DWORD+#else getEnv name =     withCString name $ \s -> do       litstring <- c_getenv s       if litstring /= nullPtr-        then peekCString litstring-        else ioException (IOError Nothing NoSuchThing "getEnv"-                          "no environment variable" Nothing (Just name))+        then GHC.peekCString fileSystemEncoding litstring+        else ioe_missingEnvVar name  foreign import ccall unsafe "getenv"    c_getenv :: CString -> IO (Ptr CChar)+#endif +ioe_missingEnvVar :: String -> IO a+ioe_missingEnvVar name = ioException (IOError Nothing NoSuchThing "getEnv"+											  "no environment variable" Nothing (Just name))+ {-| 'withArgs' @args act@ - while executing action @act@, have 'getArgs' return @args@.@@ -151,48 +246,93 @@ -- the duration of an action.  withArgv :: [String] -> IO a -> IO a-withArgv new_args act = do++#ifdef mingw32_HOST_OS+-- We have to reflect the updated arguments in the RTS-side variables as+-- well, because the RTS still consults them for error messages and the like.+-- If we don't do this then ghc-e005 fails.+withArgv new_args act = withWin32ProgArgv new_args $ withProgArgv new_args act+#else+withArgv = withProgArgv+#endif++withProgArgv :: [String] -> IO a -> IO a+withProgArgv new_args act = do   pName <- System.Environment.getProgName   existing_args <- System.Environment.getArgs-  bracket (setArgs new_args)-          (\argv -> do _ <- setArgs (pName:existing_args)-                       freeArgv argv)+  bracket (setProgArgv new_args)+          (\argv -> do _ <- setProgArgv (pName:existing_args)+                       freeProgArgv argv)           (const act) -freeArgv :: Ptr CString -> IO ()-freeArgv argv = do+freeProgArgv :: Ptr CString -> IO ()+freeProgArgv argv = do   size <- lengthArray0 nullPtr argv   sequence_ [peek (argv `advancePtr` i) >>= free | i <- [size, size-1 .. 0]]   free argv -setArgs :: [String] -> IO (Ptr CString)-setArgs argv = do-  vs <- mapM newCString argv >>= newArray0 nullPtr-  setArgsPrim (genericLength argv) vs+setProgArgv :: [String] -> IO (Ptr CString)+setProgArgv argv = do+  vs <- mapM (GHC.newCString fileSystemEncoding) argv >>= newArray0 nullPtr+  c_setProgArgv (genericLength argv) vs   return vs  foreign import ccall unsafe "setProgArgv" -  setArgsPrim  :: CInt -> Ptr CString -> IO ()+  c_setProgArgv  :: CInt -> Ptr CString -> IO ()  -- |'getEnvironment' retrieves the entire environment as a -- list of @(key,value)@ pairs. -- -- If an environment entry does not contain an @\'=\'@ character, -- the @key@ is the whole entry and the @value@ is the empty string.- getEnvironment :: IO [(String, String)]++#ifdef mingw32_HOST_OS+getEnvironment = bracket c_GetEnvironmentStrings c_FreeEnvironmentStrings $ \pBlock ->+    if pBlock == nullPtr then return []+     else go pBlock+  where+    go pBlock = do+        -- The block is terminated by a null byte where there+        -- should be an environment variable of the form X=Y+        c <- peek pBlock+        if c == 0 then return []+         else do+          -- Seek the next pair (or terminating null):+          pBlock' <- seekNull pBlock False+          -- We now know the length in bytes, but ignore it when+          -- getting the actual String:+          str <- peekCWString pBlock+          fmap (divvy str :) $ go pBlock'+    +    -- Returns pointer to the byte *after* the next null+    seekNull pBlock done = do+        let pBlock' = pBlock `plusPtr` sizeOf (undefined :: CWchar)+        if done then return pBlock'+         else do+           c <- peek pBlock'+           seekNull pBlock' (c == (0 :: Word8 ))++foreign import stdcall unsafe "windows.h GetEnvironmentStringsW"+  c_GetEnvironmentStrings :: IO (Ptr CWchar)++foreign import stdcall unsafe "windows.h FreeEnvironmentStringsW"+  c_FreeEnvironmentStrings :: Ptr CWchar -> IO Bool+#else getEnvironment = do    pBlock <- getEnvBlock    if pBlock == nullPtr then return []     else do-      stuff <- peekArray0 nullPtr pBlock >>= mapM peekCString+      stuff <- peekArray0 nullPtr pBlock >>= mapM (GHC.peekCString fileSystemEncoding)       return (map divvy stuff)-  where-   divvy str =-      case break (=='=') str of-        (xs,[])        -> (xs,[]) -- don't barf (like Posix.getEnvironment)-        (name,_:value) -> (name,value)  foreign import ccall unsafe "__hscore_environ"    getEnvBlock :: IO (Ptr CString)+#endif++divvy :: String -> (String, String)+divvy str =+  case break (=='=') str of+    (xs,[])        -> (xs,[]) -- don't barf (like Posix.getEnvironment)+    (name,_:value) -> (name,value) #endif  /* __GLASGOW_HASKELL__ */
− System/Event.hs 
@@ -1,39 +0,0 @@--- | This module provides scalable event notification for file--- descriptors and timeouts.------ This module should be considered GHC internal.-module System.Event-    ( -- * Types-      EventManager--      -- * Creation-    , new--      -- * Running-    , loop--    -- ** Stepwise running-    , step-    , shutdown--      -- * Registering interest in I/O events-    , Event-    , evtRead-    , evtWrite-    , IOCallback-    , FdKey(keyFd)-    , registerFd-    , registerFd_-    , unregisterFd-    , unregisterFd_-    , closeFd--      -- * Registering interest in timeout events-    , TimeoutCallback-    , TimeoutKey-    , registerTimeout-    , updateTimeout-    , unregisterTimeout-    ) where--import System.Event.Manager
− System/Event/Array.hs 
@@ -1,313 +0,0 @@-{-# LANGUAGE BangPatterns, CPP, ForeignFunctionInterface, NoImplicitPrelude #-}--module System.Event.Array-    (-      Array-    , capacity-    , clear-    , concat-    , copy-    , duplicate-    , empty-    , ensureCapacity-    , findIndex-    , forM_-    , length-    , loop-    , new-    , removeAt-    , snoc-    , unsafeLoad-    , unsafeRead-    , unsafeWrite-    , useAsPtr-    ) where--import Control.Monad hiding (forM_)-import Data.Bits ((.|.), shiftR)-import Data.IORef (IORef, atomicModifyIORef, newIORef, readIORef, writeIORef)-import Data.Maybe-import Foreign.C.Types (CSize)-import Foreign.ForeignPtr (ForeignPtr, withForeignPtr)-import Foreign.Ptr (Ptr, nullPtr, plusPtr)-import Foreign.Storable (Storable(..))-import GHC.Base-import GHC.Err (undefined)-import GHC.ForeignPtr (mallocPlainForeignPtrBytes, newForeignPtr_)-import GHC.Num (Num(..))-import GHC.Real (fromIntegral)-import GHC.Show (show)--#include "MachDeps.h"--#define BOUNDS_CHECKING 1--#if defined(BOUNDS_CHECKING)--- This fugly hack is brought by GHC's apparent reluctance to deal--- with MagicHash and UnboxedTuples when inferring types. Eek!-#define CHECK_BOUNDS(_func_,_len_,_k_) \-if (_k_) < 0 || (_k_) >= (_len_) then error ("System.Event.Array." ++ (_func_) ++ ": bounds error, index " ++ show (_k_) ++ ", capacity " ++ show (_len_)) else-#else-#define CHECK_BOUNDS(_func_,_len_,_k_)-#endif---- Invariant: size <= capacity-newtype Array a = Array (IORef (AC a))---- The actual array content.-data AC a = AC-    !(ForeignPtr a)  -- Elements-    !Int      -- Number of elements (length)-    !Int      -- Maximum number of elements (capacity)--empty :: IO (Array a)-empty = do-  p <- newForeignPtr_ nullPtr-  Array `fmap` newIORef (AC p 0 0)--allocArray :: Storable a => Int -> IO (ForeignPtr a)-allocArray n = allocHack undefined- where-  allocHack :: Storable a => a -> IO (ForeignPtr a)-  allocHack dummy = mallocPlainForeignPtrBytes (n * sizeOf dummy)--reallocArray :: Storable a => ForeignPtr a -> Int -> Int -> IO (ForeignPtr a)-reallocArray p newSize oldSize = reallocHack undefined p- where-  reallocHack :: Storable a => a -> ForeignPtr a -> IO (ForeignPtr a)-  reallocHack dummy src = do-      let size = sizeOf dummy-      dst <- mallocPlainForeignPtrBytes (newSize * size)-      withForeignPtr src $ \s ->-        when (s /= nullPtr && oldSize > 0) .-          withForeignPtr dst $ \d -> do-            _ <- memcpy d s (fromIntegral (oldSize * size))-            return ()-      return dst--new :: Storable a => Int -> IO (Array a)-new c = do-    es <- allocArray cap-    fmap Array (newIORef (AC es 0 cap))-  where-    cap = firstPowerOf2 c--duplicate :: Storable a => Array a -> IO (Array a)-duplicate a = dupHack undefined a- where-  dupHack :: Storable b => b -> Array b -> IO (Array b)-  dupHack dummy (Array ref) = do-    AC es len cap <- readIORef ref-    ary <- allocArray cap-    withForeignPtr ary $ \dest ->-      withForeignPtr es $ \src -> do-        _ <- memcpy dest src (fromIntegral (len * sizeOf dummy))-        return ()-    Array `fmap` newIORef (AC ary len cap)--length :: Array a -> IO Int-length (Array ref) = do-    AC _ len _ <- readIORef ref-    return len--capacity :: Array a -> IO Int-capacity (Array ref) = do-    AC _ _ cap <- readIORef ref-    return cap--unsafeRead :: Storable a => Array a -> Int -> IO a-unsafeRead (Array ref) ix = do-    AC es _ cap <- readIORef ref-    CHECK_BOUNDS("unsafeRead",cap,ix)-      withForeignPtr es $ \p ->-        peekElemOff p ix--unsafeWrite :: Storable a => Array a -> Int -> a -> IO ()-unsafeWrite (Array ref) ix a = do-    ac <- readIORef ref-    unsafeWrite' ac ix a--unsafeWrite' :: Storable a => AC a -> Int -> a -> IO ()-unsafeWrite' (AC es _ cap) ix a = do-    CHECK_BOUNDS("unsafeWrite'",cap,ix)-      withForeignPtr es $ \p ->-        pokeElemOff p ix a--unsafeLoad :: Storable a => Array a -> (Ptr a -> Int -> IO Int) -> IO Int-unsafeLoad (Array ref) load = do-    AC es _ cap <- readIORef ref-    len' <- withForeignPtr es $ \p -> load p cap-    writeIORef ref (AC es len' cap)-    return len'--ensureCapacity :: Storable a => Array a -> Int -> IO ()-ensureCapacity (Array ref) c = do-    ac@(AC _ _ cap) <- readIORef ref-    ac'@(AC _ _ cap') <- ensureCapacity' ac c-    when (cap' /= cap) $-      writeIORef ref ac'--ensureCapacity' :: Storable a => AC a -> Int -> IO (AC a)-ensureCapacity' ac@(AC es len cap) c = do-    if c > cap-      then do-        es' <- reallocArray es cap' cap-        return (AC es' len cap')-      else-        return ac-  where-    cap' = firstPowerOf2 c--useAsPtr :: Array a -> (Ptr a -> Int -> IO b) -> IO b-useAsPtr (Array ref) f = do-    AC es len _ <- readIORef ref-    withForeignPtr es $ \p -> f p len--snoc :: Storable a => Array a -> a -> IO ()-snoc (Array ref) e = do-    ac@(AC _ len _) <- readIORef ref-    let len' = len + 1-    ac'@(AC es _ cap) <- ensureCapacity' ac len'-    unsafeWrite' ac' len e-    writeIORef ref (AC es len' cap)--clear :: Storable a => Array a -> IO ()-clear (Array ref) = do-  !_ <- atomicModifyIORef ref $ \(AC es _ cap) ->-        let e = AC es 0 cap in (e, e)-  return ()--forM_ :: Storable a => Array a -> (a -> IO ()) -> IO ()-forM_ ary g = forHack ary g undefined-  where-    forHack :: Storable b => Array b -> (b -> IO ()) -> b -> IO ()-    forHack (Array ref) f dummy = do-      AC es len _ <- readIORef ref-      let size = sizeOf dummy-          offset = len * size-      withForeignPtr es $ \p -> do-        let go n | n >= offset = return ()-                 | otherwise = do-              f =<< peek (p `plusPtr` n)-              go (n + size)-        go 0--loop :: Storable a => Array a -> b -> (b -> a -> IO (b,Bool)) -> IO ()-loop ary z g = loopHack ary z g undefined-  where-    loopHack :: Storable b => Array b -> c -> (c -> b -> IO (c,Bool)) -> b-             -> IO ()-    loopHack (Array ref) y f dummy = do-      AC es len _ <- readIORef ref-      let size = sizeOf dummy-          offset = len * size-      withForeignPtr es $ \p -> do-        let go n k-                | n >= offset = return ()-                | otherwise = do-                      (k',cont) <- f k =<< peek (p `plusPtr` n)-                      when cont $ go (n + size) k'-        go 0 y--findIndex :: Storable a => (a -> Bool) -> Array a -> IO (Maybe (Int,a))-findIndex = findHack undefined- where-  findHack :: Storable b => b -> (b -> Bool) -> Array b -> IO (Maybe (Int,b))-  findHack dummy p (Array ref) = do-    AC es len _ <- readIORef ref-    let size   = sizeOf dummy-        offset = len * size-    withForeignPtr es $ \ptr ->-      let go !n !i-            | n >= offset = return Nothing-            | otherwise = do-                val <- peek (ptr `plusPtr` n)-                if p val-                  then return $ Just (i, val)-                  else go (n + size) (i + 1)-      in  go 0 0--concat :: Storable a => Array a -> Array a -> IO ()-concat (Array d) (Array s) = do-  da@(AC _ dlen _) <- readIORef d-  sa@(AC _ slen _) <- readIORef s-  writeIORef d =<< copy' da dlen sa 0 slen---- | Copy part of the source array into the destination array. The--- destination array is resized if not large enough.-copy :: Storable a => Array a -> Int -> Array a -> Int -> Int -> IO ()-copy (Array d) dstart (Array s) sstart maxCount = do-  da <- readIORef d-  sa <- readIORef s-  writeIORef d =<< copy' da dstart sa sstart maxCount---- | Copy part of the source array into the destination array. The--- destination array is resized if not large enough.-copy' :: Storable a => AC a -> Int -> AC a -> Int -> Int -> IO (AC a)-copy' d dstart s sstart maxCount = copyHack d s undefined- where-  copyHack :: Storable b => AC b -> AC b -> b -> IO (AC b)-  copyHack dac@(AC _ oldLen _) (AC src slen _) dummy = do-    when (maxCount < 0 || dstart < 0 || dstart > oldLen || sstart < 0 ||-          sstart > slen) $ error "copy: bad offsets or lengths"-    let size = sizeOf dummy-        count = min maxCount (slen - sstart)-    if count == 0-      then return dac-      else do-        AC dst dlen dcap <- ensureCapacity' dac (dstart + count)-        withForeignPtr dst $ \dptr ->-          withForeignPtr src $ \sptr -> do-            _ <- memcpy (dptr `plusPtr` (dstart * size))-                        (sptr `plusPtr` (sstart * size))-                        (fromIntegral (count * size))-            return $ AC dst (max dlen (dstart + count)) dcap--removeAt :: Storable a => Array a -> Int -> IO ()-removeAt a i = removeHack a undefined- where-  removeHack :: Storable b => Array b -> b -> IO ()-  removeHack (Array ary) dummy = do-    AC fp oldLen cap <- readIORef ary-    when (i < 0 || i >= oldLen) $ error "removeAt: invalid index"-    let size   = sizeOf dummy-        newLen = oldLen - 1-    when (newLen > 0 && i < newLen) .-      withForeignPtr fp $ \ptr -> do-        _ <- memmove (ptr `plusPtr` (size * i))-                     (ptr `plusPtr` (size * (i+1)))-                     (fromIntegral (size * (newLen-i)))-        return ()-    writeIORef ary (AC fp newLen cap)--{-The firstPowerOf2 function works by setting all bits on the right-hand-side of the most significant flagged bit to 1, and then incrementing-the entire value at the end so it "rolls over" to the nearest power of-two.--}---- | Computes the next-highest power of two for a particular integer,--- @n@.  If @n@ is already a power of two, returns @n@.  If @n@ is--- zero, returns zero, even though zero is not a power of two.-firstPowerOf2 :: Int -> Int-firstPowerOf2 !n =-    let !n1 = n - 1-        !n2 = n1 .|. (n1 `shiftR` 1)-        !n3 = n2 .|. (n2 `shiftR` 2)-        !n4 = n3 .|. (n3 `shiftR` 4)-        !n5 = n4 .|. (n4 `shiftR` 8)-        !n6 = n5 .|. (n5 `shiftR` 16)-#if WORD_SIZE_IN_BITS == 32-    in n6 + 1-#elif WORD_SIZE_IN_BITS == 64-        !n7 = n6 .|. (n6 `shiftR` 32)-    in n7 + 1-#else-# error firstPowerOf2 not defined on this architecture-#endif--foreign import ccall unsafe "string.h memcpy"-    memcpy :: Ptr a -> Ptr a -> CSize -> IO (Ptr a)--foreign import ccall unsafe "string.h memmove"-    memmove :: Ptr a -> Ptr a -> CSize -> IO (Ptr a)
− System/Event/Clock.hsc 
@@ -1,48 +0,0 @@-{-# LANGUAGE ForeignFunctionInterface #-}--module System.Event.Clock (getCurrentTime) where--#include <sys/time.h>--import Foreign (Ptr, Storable(..), nullPtr, with)-import Foreign.C.Error (throwErrnoIfMinus1_)-import Foreign.C.Types (CInt, CLong)-import GHC.Base-import GHC.Err-import GHC.Num-import GHC.Real---- TODO: Implement this for Windows.---- | Return the current time, in seconds since Jan. 1, 1970.-getCurrentTime :: IO Double-getCurrentTime = do-    tv <- with (CTimeval 0 0) $ \tvptr -> do-        throwErrnoIfMinus1_ "gettimeofday" (gettimeofday tvptr nullPtr)-        peek tvptr-    let !t = fromIntegral (sec tv) + fromIntegral (usec tv) / 1000000.0-    return t----------------------------------------------------------------------------- FFI binding--data CTimeval = CTimeval-    { sec  :: {-# UNPACK #-} !CLong-    , usec :: {-# UNPACK #-} !CLong-    }--instance Storable CTimeval where-    sizeOf _ = #size struct timeval-    alignment _ = alignment (undefined :: CLong)--    peek ptr = do-        sec' <- #{peek struct timeval, tv_sec} ptr-        usec' <- #{peek struct timeval, tv_usec} ptr-        return $ CTimeval sec' usec'--    poke ptr tv = do-        #{poke struct timeval, tv_sec} ptr (sec tv)-        #{poke struct timeval, tv_usec} ptr (usec tv)--foreign import ccall unsafe "sys/time.h gettimeofday" gettimeofday-    :: Ptr CTimeval -> Ptr () -> IO CInt
− System/Event/Control.hs 
@@ -1,210 +0,0 @@-{-# LANGUAGE CPP, ForeignFunctionInterface, NoImplicitPrelude,-    ScopedTypeVariables #-}--module System.Event.Control-    (-    -- * Managing the IO manager-      Signal-    , ControlMessage(..)-    , Control-    , newControl-    , closeControl-    -- ** Control message reception-    , readControlMessage-    -- *** File descriptors-    , controlReadFd-    , wakeupReadFd-    -- ** Control message sending-    , sendWakeup-    , sendDie-    -- * Utilities-    , setNonBlockingFD-    ) where--#include "EventConfig.h"--import Control.Monad (when)-import Foreign.ForeignPtr (ForeignPtr)-import GHC.Base-import GHC.Conc.Signal (Signal)-import GHC.Real (fromIntegral)-import GHC.Show (Show)-import GHC.Word (Word8)-import Foreign.C.Error (throwErrnoIfMinus1_)-import Foreign.C.Types (CInt, CSize)-import Foreign.ForeignPtr (mallocForeignPtrBytes, withForeignPtr)-import Foreign.Marshal (alloca, allocaBytes)-import Foreign.Marshal.Array (allocaArray)-import Foreign.Ptr (castPtr)-import Foreign.Storable (peek, peekElemOff, poke)-import System.Posix.Internals (c_close, c_pipe, c_read, c_write,-                               setCloseOnExec, setNonBlockingFD)-import System.Posix.Types (Fd)--#if defined(HAVE_EVENTFD)-import Data.Word (Word64)-import Foreign.C.Error (throwErrnoIfMinus1)-#else-import Foreign.C.Error (eAGAIN, eWOULDBLOCK, getErrno, throwErrno)-#endif--data ControlMessage = CMsgWakeup-                    | CMsgDie-                    | CMsgSignal {-# UNPACK #-} !(ForeignPtr Word8)-                                 {-# UNPACK #-} !Signal-    deriving (Eq, Show)---- | The structure used to tell the IO manager thread what to do.-data Control = W {-      controlReadFd  :: {-# UNPACK #-} !Fd-    , controlWriteFd :: {-# UNPACK #-} !Fd-#if defined(HAVE_EVENTFD)-    , controlEventFd :: {-# UNPACK #-} !Fd-#else-    , wakeupReadFd   :: {-# UNPACK #-} !Fd-    , wakeupWriteFd  :: {-# UNPACK #-} !Fd-#endif-    } deriving (Show)--#if defined(HAVE_EVENTFD)-wakeupReadFd :: Control -> Fd-wakeupReadFd = controlEventFd-{-# INLINE wakeupReadFd #-}-#endif--setNonBlock :: CInt -> IO ()-setNonBlock fd =-#if __GLASGOW_HASKELL__ >= 611-  setNonBlockingFD fd True-#else-  setNonBlockingFD fd-#endif---- | Create the structure (usually a pipe) used for waking up the IO--- manager thread from another thread.-newControl :: IO Control-newControl = allocaArray 2 $ \fds -> do-  let createPipe = do-        throwErrnoIfMinus1_ "pipe" $ c_pipe fds-        rd <- peekElemOff fds 0-        wr <- peekElemOff fds 1-        -- The write end must be non-blocking, since we may need to-        -- poke the event manager from a signal handler.-        setNonBlock wr-        setCloseOnExec rd-        setCloseOnExec wr-        return (rd, wr)-  (ctrl_rd, ctrl_wr) <- createPipe-  c_setIOManagerControlFd ctrl_wr-#if defined(HAVE_EVENTFD)-  ev <- throwErrnoIfMinus1 "eventfd" $ c_eventfd 0 0-  setNonBlock ev-  setCloseOnExec ev-  c_setIOManagerWakeupFd ev-#else-  (wake_rd, wake_wr) <- createPipe-  c_setIOManagerWakeupFd wake_wr-#endif-  return W { controlReadFd  = fromIntegral ctrl_rd-           , controlWriteFd = fromIntegral ctrl_wr-#if defined(HAVE_EVENTFD)-           , controlEventFd = fromIntegral ev-#else-           , wakeupReadFd   = fromIntegral wake_rd-           , wakeupWriteFd  = fromIntegral wake_wr-#endif-           }---- | Close the control structure used by the IO manager thread.-closeControl :: Control -> IO ()-closeControl w = do-  _ <- c_close . fromIntegral . controlReadFd $ w-  _ <- c_close . fromIntegral . controlWriteFd $ w-#if defined(HAVE_EVENTFD)-  _ <- c_close . fromIntegral . controlEventFd $ w-#else-  _ <- c_close . fromIntegral . wakeupReadFd $ w-  _ <- c_close . fromIntegral . wakeupWriteFd $ w-#endif-  return ()--io_MANAGER_WAKEUP, io_MANAGER_DIE :: Word8-io_MANAGER_WAKEUP = 0xff-io_MANAGER_DIE    = 0xfe--foreign import ccall "__hscore_sizeof_siginfo_t"-    sizeof_siginfo_t :: CSize--readControlMessage :: Control -> Fd -> IO ControlMessage-readControlMessage ctrl fd-    | fd == wakeupReadFd ctrl = allocaBytes wakeupBufferSize $ \p -> do-                    throwErrnoIfMinus1_ "readWakeupMessage" $-                      c_read (fromIntegral fd) p (fromIntegral wakeupBufferSize)-                    return CMsgWakeup-    | otherwise =-        alloca $ \p -> do-            throwErrnoIfMinus1_ "readControlMessage" $-                c_read (fromIntegral fd) p 1-            s <- peek p-            case s of-                -- Wakeup messages shouldn't be sent on the control-                -- file descriptor but we handle them anyway.-                _ | s == io_MANAGER_WAKEUP -> return CMsgWakeup-                _ | s == io_MANAGER_DIE    -> return CMsgDie-                _ -> do  -- Signal-                    fp <- mallocForeignPtrBytes (fromIntegral sizeof_siginfo_t)-                    withForeignPtr fp $ \p_siginfo -> do-                        r <- c_read (fromIntegral fd) (castPtr p_siginfo)-                             sizeof_siginfo_t-                        when (r /= fromIntegral sizeof_siginfo_t) $-                            error "failed to read siginfo_t"-                        let !s' = fromIntegral s-                        return $ CMsgSignal fp s'--  where wakeupBufferSize =-#if defined(HAVE_EVENTFD)-            8-#else-            4096-#endif--sendWakeup :: Control -> IO ()-#if defined(HAVE_EVENTFD)-sendWakeup c = alloca $ \p -> do-  poke p (1 :: Word64)-  throwErrnoIfMinus1_ "sendWakeup" $-    c_write (fromIntegral (controlEventFd c)) (castPtr p) 8-#else-sendWakeup c = do-  n <- sendMessage (wakeupWriteFd c) CMsgWakeup-  case n of-    _ | n /= -1   -> return ()-      | otherwise -> do-                   errno <- getErrno-                   when (errno /= eAGAIN && errno /= eWOULDBLOCK) $-                     throwErrno "sendWakeup"-#endif--sendDie :: Control -> IO ()-sendDie c = throwErrnoIfMinus1_ "sendDie" $-            sendMessage (controlWriteFd c) CMsgDie--sendMessage :: Fd -> ControlMessage -> IO Int-sendMessage fd msg = alloca $ \p -> do-  case msg of-    CMsgWakeup        -> poke p io_MANAGER_WAKEUP-    CMsgDie           -> poke p io_MANAGER_DIE-    CMsgSignal _fp _s -> error "Signals can only be sent from within the RTS"-  fromIntegral `fmap` c_write (fromIntegral fd) p 1--#if defined(HAVE_EVENTFD)-foreign import ccall unsafe "sys/eventfd.h eventfd"-   c_eventfd :: CInt -> CInt -> IO CInt-#endif---- Used to tell the RTS how it can send messages to the I/O manager.-foreign import ccall "setIOManagerControlFd"-   c_setIOManagerControlFd :: CInt -> IO ()--foreign import ccall "setIOManagerWakeupFd"-   c_setIOManagerWakeupFd :: CInt -> IO ()
− System/Event/EPoll.hsc 
@@ -1,213 +0,0 @@-{-# LANGUAGE ForeignFunctionInterface, GeneralizedNewtypeDeriving,-    NoImplicitPrelude #-}------- | A binding to the epoll I/O event notification facility------ epoll is a variant of poll that can be used either as an edge-triggered or--- a level-triggered interface and scales well to large numbers of watched file--- descriptors.------ epoll decouples monitor an fd from the process of registering it.----module System.Event.EPoll-    (-      new-    , available-    ) where--import qualified System.Event.Internal as E--#include "EventConfig.h"-#if !defined(HAVE_EPOLL)-import GHC.Base--new :: IO E.Backend-new = error "EPoll back end not implemented for this platform"--available :: Bool-available = False-{-# INLINE available #-}-#else--#include <sys/epoll.h>--import Control.Monad (when)-import Data.Bits (Bits, (.|.), (.&.))-import Data.Monoid (Monoid(..))-import Data.Word (Word32)-import Foreign.C.Error (throwErrnoIfMinus1, throwErrnoIfMinus1_)-import Foreign.C.Types (CInt)-import Foreign.Marshal.Utils (with)-import Foreign.Ptr (Ptr)-import Foreign.Storable (Storable(..))-import GHC.Base-import GHC.Err (undefined)-import GHC.Num (Num(..))-import GHC.Real (ceiling, fromIntegral)-import GHC.Show (Show)-import System.Posix.Internals (c_close)-#if !defined(HAVE_EPOLL_CREATE1)-import System.Posix.Internals (setCloseOnExec)-#endif-import System.Posix.Types (Fd(..))--import qualified System.Event.Array    as A-import           System.Event.Internal (Timeout(..))--available :: Bool-available = True-{-# INLINE available #-}--data EPoll = EPoll {-      epollFd     :: {-# UNPACK #-} !EPollFd-    , epollEvents :: {-# UNPACK #-} !(A.Array Event)-    }---- | Create a new epoll backend.-new :: IO E.Backend-new = do-  epfd <- epollCreate-  evts <- A.new 64-  let !be = E.backend poll modifyFd delete (EPoll epfd evts)-  return be--delete :: EPoll -> IO ()-delete be = do-  _ <- c_close . fromEPollFd . epollFd $ be-  return ()---- | Change the set of events we are interested in for a given file--- descriptor.-modifyFd :: EPoll -> Fd -> E.Event -> E.Event -> IO ()-modifyFd ep fd oevt nevt = with (Event (fromEvent nevt) fd) $-                             epollControl (epollFd ep) op fd-  where op | oevt == mempty = controlOpAdd-           | nevt == mempty = controlOpDelete-           | otherwise      = controlOpModify---- | Select a set of file descriptors which are ready for I/O--- operations and call @f@ for all ready file descriptors, passing the--- events that are ready.-poll :: EPoll                     -- ^ state-     -> Timeout                   -- ^ timeout in milliseconds-     -> (Fd -> E.Event -> IO ())  -- ^ I/O callback-     -> IO ()-poll ep timeout f = do-  let events = epollEvents ep--  -- Will return zero if the system call was interupted, in which case-  -- we just return (and try again later.)-  n <- A.unsafeLoad events $ \es cap ->-       epollWait (epollFd ep) es cap $ fromTimeout timeout--  when (n > 0) $ do-    A.forM_ events $ \e -> f (eventFd e) (toEvent (eventTypes e))-    cap <- A.capacity events-    when (cap == n) $ A.ensureCapacity events (2 * cap)--newtype EPollFd = EPollFd {-      fromEPollFd :: CInt-    } deriving (Eq, Show)--data Event = Event {-      eventTypes :: EventType-    , eventFd    :: Fd-    } deriving (Show)--instance Storable Event where-    sizeOf    _ = #size struct epoll_event-    alignment _ = alignment (undefined :: CInt)--    peek ptr = do-        ets <- #{peek struct epoll_event, events} ptr-        ed  <- #{peek struct epoll_event, data.fd}   ptr-        let !ev = Event (EventType ets) ed-        return ev--    poke ptr e = do-        #{poke struct epoll_event, events} ptr (unEventType $ eventTypes e)-        #{poke struct epoll_event, data.fd}   ptr (eventFd e)--newtype ControlOp = ControlOp CInt--#{enum ControlOp, ControlOp- , controlOpAdd    = EPOLL_CTL_ADD- , controlOpModify = EPOLL_CTL_MOD- , controlOpDelete = EPOLL_CTL_DEL- }--newtype EventType = EventType {-      unEventType :: Word32-    } deriving (Show, Eq, Num, Bits)--#{enum EventType, EventType- , epollIn  = EPOLLIN- , epollOut = EPOLLOUT- , epollErr = EPOLLERR- , epollHup = EPOLLHUP- }---- | Create a new epoll context, returning a file descriptor associated with the context.--- The fd may be used for subsequent calls to this epoll context.------ The size parameter to epoll_create is a hint about the expected number of handles.------ The file descriptor returned from epoll_create() should be destroyed via--- a call to close() after polling is finished----epollCreate :: IO EPollFd-epollCreate = do-  fd <- throwErrnoIfMinus1 "epollCreate" $-#if defined(HAVE_EPOLL_CREATE1)-        c_epoll_create1 (#const EPOLL_CLOEXEC)-#else-        c_epoll_create 256 -- argument is ignored-  setCloseOnExec fd-#endif-  let !epollFd' = EPollFd fd-  return epollFd'--epollControl :: EPollFd -> ControlOp -> Fd -> Ptr Event -> IO ()-epollControl (EPollFd epfd) (ControlOp op) (Fd fd) event =-    throwErrnoIfMinus1_ "epollControl" $ c_epoll_ctl epfd op fd event--epollWait :: EPollFd -> Ptr Event -> Int -> Int -> IO Int-epollWait (EPollFd epfd) events numEvents timeout =-    fmap fromIntegral .-    E.throwErrnoIfMinus1NoRetry "epollWait" $-    c_epoll_wait epfd events (fromIntegral numEvents) (fromIntegral timeout)--fromEvent :: E.Event -> EventType-fromEvent e = remap E.evtRead  epollIn .|.-              remap E.evtWrite epollOut-  where remap evt to-            | e `E.eventIs` evt = to-            | otherwise         = 0--toEvent :: EventType -> E.Event-toEvent e = remap (epollIn  .|. epollErr .|. epollHup) E.evtRead `mappend`-            remap (epollOut .|. epollErr .|. epollHup) E.evtWrite-  where remap evt to-            | e .&. evt /= 0 = to-            | otherwise      = mempty--fromTimeout :: Timeout -> Int-fromTimeout Forever     = -1-fromTimeout (Timeout s) = ceiling $ 1000 * s--#if defined(HAVE_EPOLL_CREATE1)-foreign import ccall unsafe "sys/epoll.h epoll_create1"-    c_epoll_create1 :: CInt -> IO CInt-#else-foreign import ccall unsafe "sys/epoll.h epoll_create"-    c_epoll_create :: CInt -> IO CInt-#endif--foreign import ccall unsafe "sys/epoll.h epoll_ctl"-    c_epoll_ctl :: CInt -> CInt -> CInt -> Ptr Event -> IO CInt--foreign import ccall safe "sys/epoll.h epoll_wait"-    c_epoll_wait :: CInt -> Ptr Event -> CInt -> CInt -> IO CInt--#endif /* defined(HAVE_EPOLL) */
− System/Event/IntMap.hs 
@@ -1,374 +0,0 @@-{-# LANGUAGE CPP, MagicHash, NoImplicitPrelude #-}--------------------------------------------------------------------------------- |--- Module      :  System.Event.IntMap--- Copyright   :  (c) Daan Leijen 2002---                (c) Andriy Palamarchuk 2008--- License     :  BSD-style--- Maintainer  :  libraries@haskell.org--- Stability   :  provisional--- Portability :  portable------ An efficient implementation of maps from integer keys to values.------ Since many function names (but not the type name) clash with--- "Prelude" names, this module is usually imported @qualified@, e.g.------ >  import Data.IntMap (IntMap)--- >  import qualified Data.IntMap as IntMap------ The implementation is based on /big-endian patricia trees/.  This data--- structure performs especially well on binary operations like 'union'--- and 'intersection'.  However, my benchmarks show that it is also--- (much) faster on insertions and deletions when compared to a generic--- size-balanced map implementation (see "Data.Map").------    * Chris Okasaki and Andy Gill,  \"/Fast Mergeable Integer Maps/\",---      Workshop on ML, September 1998, pages 77-86,---      <http://citeseer.ist.psu.edu/okasaki98fast.html>------    * D.R. Morrison, \"/PATRICIA -- Practical Algorithm To Retrieve---      Information Coded In Alphanumeric/\", Journal of the ACM, 15(4),---      October 1968, pages 514-534.------ Operation comments contain the operation time complexity in--- the Big-O notation <http://en.wikipedia.org/wiki/Big_O_notation>.--- Many operations have a worst-case complexity of /O(min(n,W))/.--- This means that the operation can become linear in the number of--- elements with a maximum of /W/ -- the number of bits in an 'Int'--- (32 or 64).--------------------------------------------------------------------------------module System.Event.IntMap-    (-    -- * Map type-    IntMap-    , Key--    -- * Query-    , lookup-    , member--    -- * Construction-    , empty--    -- * Insertion-    , insertWith--    -- * Delete\/Update-    , delete-    , updateWith--    -- * Traversal-    -- ** Fold-    , foldWithKey--    -- * Conversion-    , keys-    ) where--import Data.Bits--import Data.Maybe (Maybe(..))-import GHC.Base hiding (foldr)-import GHC.Num (Num(..))-import GHC.Real (fromIntegral)-import GHC.Show (Show(showsPrec), showParen, shows, showString)--#if __GLASGOW_HASKELL__-import GHC.Word (Word(..))-#else-import Data.Word-#endif---- | A @Nat@ is a natural machine word (an unsigned Int)-type Nat = Word--natFromInt :: Key -> Nat-natFromInt i = fromIntegral i--intFromNat :: Nat -> Key-intFromNat w = fromIntegral w--shiftRL :: Nat -> Key -> Nat-#if __GLASGOW_HASKELL__--- GHC: use unboxing to get @shiftRL@ inlined.-shiftRL (W# x) (I# i) = W# (shiftRL# x i)-#else-shiftRL x i = shiftR x i-#endif----------------------------------------------------------------------------- Types---- | A map of integers to values @a@.-data IntMap a = Nil-              | Tip {-# UNPACK #-} !Key !a-              | Bin {-# UNPACK #-} !Prefix-                    {-# UNPACK #-} !Mask-                    !(IntMap a)-                    !(IntMap a)--type Prefix = Int-type Mask   = Int-type Key    = Int----------------------------------------------------------------------------- Query---- | /O(min(n,W))/ Lookup the value at a key in the map.  See also--- 'Data.Map.lookup'.-lookup :: Key -> IntMap a -> Maybe a-lookup k t = let nk = natFromInt k in seq nk (lookupN nk t)--lookupN :: Nat -> IntMap a -> Maybe a-lookupN k t-  = case t of-      Bin _ m l r-        | zeroN k (natFromInt m) -> lookupN k l-        | otherwise              -> lookupN k r-      Tip kx x-        | (k == natFromInt kx)  -> Just x-        | otherwise             -> Nothing-      Nil -> Nothing---- | /O(min(n,W))/. Is the key a member of the map?------ > member 5 (fromList [(5,'a'), (3,'b')]) == True--- > member 1 (fromList [(5,'a'), (3,'b')]) == False--member :: Key -> IntMap a -> Bool-member k m-  = case lookup k m of-      Nothing -> False-      Just _  -> True----------------------------------------------------------------------------- Construction---- | /O(1)/ The empty map.------ > empty      == fromList []--- > size empty == 0-empty :: IntMap a-empty = Nil----------------------------------------------------------------------------- Insert---- | /O(min(n,W))/ Insert with a function, combining new value and old--- value.  @insertWith f key value mp@ will insert the pair (key,--- value) into @mp@ if key does not exist in the map.  If the key does--- exist, the function will insert the pair (key, f new_value--- old_value).  The result is a pair where the first element is the--- old value, if one was present, and the second is the modified map.-insertWith :: (a -> a -> a) -> Key -> a -> IntMap a -> (Maybe a, IntMap a)-insertWith f k x t = case t of-    Bin p m l r-        | nomatch k p m -> (Nothing, join k (Tip k x) p t)-        | zero k m      -> let (found, l') = insertWith f k x l-                           in (found, Bin p m l' r)-        | otherwise     -> let (found, r') = insertWith f k x r-                           in (found, Bin p m l r')-    Tip ky y-        | k == ky       -> (Just y, Tip k (f x y))-        | otherwise     -> (Nothing, join k (Tip k x) ky t)-    Nil                 -> (Nothing, Tip k x)------------------------------------------------------------------------------ Delete/Update---- | /O(min(n,W))/. Delete a key and its value from the map.  When the--- key is not a member of the map, the original map is returned.  The--- result is a pair where the first element is the value associated--- with the deleted key, if one existed, and the second element is the--- modified map.-delete :: Key -> IntMap a -> (Maybe a, IntMap a)-delete k t = case t of-   Bin p m l r-        | nomatch k p m -> (Nothing, t)-        | zero k m      -> let (found, l') = delete k l-                           in (found, bin p m l' r)-        | otherwise     -> let (found, r') = delete k r-                           in (found, bin p m l r')-   Tip ky y-        | k == ky       -> (Just y, Nil)-        | otherwise     -> (Nothing, t)-   Nil                  -> (Nothing, Nil)--updateWith :: (a -> Maybe a) -> Key -> IntMap a -> (Maybe a, IntMap a)-updateWith f k t = case t of-    Bin p m l r-        | nomatch k p m -> (Nothing, t)-        | zero k m      -> let (found, l') = updateWith f k l-                           in (found, bin p m l' r)-        | otherwise     -> let (found, r') = updateWith f k r-                           in (found, bin p m l r')-    Tip ky y-        | k == ky       -> case (f y) of-                               Just y' -> (Just y, Tip ky y')-                               Nothing -> (Just y, Nil)-        | otherwise     -> (Nothing, t)-    Nil                 -> (Nothing, Nil)--- | /O(n)/. Fold the keys and values in the map, such that--- @'foldWithKey' f z == 'Prelude.foldr' ('uncurry' f) z . 'toAscList'@.--- For example,------ > keys map = foldWithKey (\k x ks -> k:ks) [] map------ > let f k a result = result ++ "(" ++ (show k) ++ ":" ++ a ++ ")"--- > foldWithKey f "Map: " (fromList [(5,"a"), (3,"b")]) == "Map: (5:a)(3:b)"--foldWithKey :: (Key -> a -> b -> b) -> b -> IntMap a -> b-foldWithKey f z t-  = foldr f z t---- | /O(n)/. Convert the map to a list of key\/value pairs.------ > toList (fromList [(5,"a"), (3,"b")]) == [(3,"b"), (5,"a")]--- > toList empty == []--toList :: IntMap a -> [(Key,a)]-toList t-  = foldWithKey (\k x xs -> (k,x):xs) [] t--foldr :: (Key -> a -> b -> b) -> b -> IntMap a -> b-foldr f z t-  = case t of-      Bin 0 m l r | m < 0 -> foldr' f (foldr' f z l) r  -- put negative numbers before.-      Bin _ _ _ _ -> foldr' f z t-      Tip k x     -> f k x z-      Nil         -> z--foldr' :: (Key -> a -> b -> b) -> b -> IntMap a -> b-foldr' f z t-  = case t of-      Bin _ _ l r -> foldr' f (foldr' f z r) l-      Tip k x     -> f k x z-      Nil         -> z---- | /O(n)/. Return all keys of the map in ascending order.------ > keys (fromList [(5,"a"), (3,"b")]) == [3,5]--- > keys empty == []--keys  :: IntMap a -> [Key]-keys m-  = foldWithKey (\k _ ks -> k:ks) [] m----------------------------------------------------------------------------- Eq--instance Eq a => Eq (IntMap a) where-    t1 == t2 = equal t1 t2-    t1 /= t2 = nequal t1 t2--equal :: Eq a => IntMap a -> IntMap a -> Bool-equal (Bin p1 m1 l1 r1) (Bin p2 m2 l2 r2)-    = (m1 == m2) && (p1 == p2) && (equal l1 l2) && (equal r1 r2)-equal (Tip kx x) (Tip ky y)-    = (kx == ky) && (x==y)-equal Nil Nil = True-equal _   _   = False--nequal :: Eq a => IntMap a -> IntMap a -> Bool-nequal (Bin p1 m1 l1 r1) (Bin p2 m2 l2 r2)-    = (m1 /= m2) || (p1 /= p2) || (nequal l1 l2) || (nequal r1 r2)-nequal (Tip kx x) (Tip ky y)-    = (kx /= ky) || (x/=y)-nequal Nil Nil = False-nequal _   _   = True--instance Show a => Show (IntMap a) where-  showsPrec d m   = showParen (d > 10) $-    showString "fromList " . shows (toList m)----------------------------------------------------------------------------- Utility functions--join :: Prefix -> IntMap a -> Prefix -> IntMap a -> IntMap a-join p1 t1 p2 t2-  | zero p1 m = Bin p m t1 t2-  | otherwise = Bin p m t2 t1-  where-    m = branchMask p1 p2-    p = mask p1 m---- | @bin@ assures that we never have empty trees within a tree.-bin :: Prefix -> Mask -> IntMap a -> IntMap a -> IntMap a-bin _ _ l Nil = l-bin _ _ Nil r = r-bin p m l r   = Bin p m l r----------------------------------------------------------------------------- Endian independent bit twiddling--zero :: Key -> Mask -> Bool-zero i m = (natFromInt i) .&. (natFromInt m) == 0--nomatch :: Key -> Prefix -> Mask -> Bool-nomatch i p m = (mask i m) /= p--mask :: Key -> Mask -> Prefix-mask i m = maskW (natFromInt i) (natFromInt m)--zeroN :: Nat -> Nat -> Bool-zeroN i m = (i .&. m) == 0----------------------------------------------------------------------------- Big endian operations--maskW :: Nat -> Nat -> Prefix-maskW i m = intFromNat (i .&. (complement (m-1) `xor` m))--branchMask :: Prefix -> Prefix -> Mask-branchMask p1 p2-    = intFromNat (highestBitMask (natFromInt p1 `xor` natFromInt p2))--{--Finding the highest bit mask in a word [x] can be done efficiently in-three ways:--* convert to a floating point value and the mantissa tells us the-  [log2(x)] that corresponds with the highest bit position. The mantissa-  is retrieved either via the standard C function [frexp] or by some bit-  twiddling on IEEE compatible numbers (float). Note that one needs to-  use at least [double] precision for an accurate mantissa of 32 bit-  numbers.--* use bit twiddling, a logarithmic sequence of bitwise or's and shifts (bit).--* use processor specific assembler instruction (asm).--The most portable way would be [bit], but is it efficient enough?-I have measured the cycle counts of the different methods on an AMD-Athlon-XP 1800 (~ Pentium III 1.8Ghz) using the RDTSC instruction:--highestBitMask: method  cycles-                ---------------                 frexp   200-                 float    33-                 bit      11-                 asm      12--Wow, the bit twiddling is on today's RISC like machines even faster-than a single CISC instruction (BSR)!--}---- | @highestBitMask@ returns a word where only the highest bit is--- set.  It is found by first setting all bits in lower positions than--- the highest bit and than taking an exclusive or with the original--- value.  Allthough the function may look expensive, GHC compiles--- this into excellent C code that subsequently compiled into highly--- efficient machine code. The algorithm is derived from Jorg Arndt's--- FXT library.-highestBitMask :: Nat -> Nat-highestBitMask x0-  = case (x0 .|. shiftRL x0 1) of-     x1 -> case (x1 .|. shiftRL x1 2) of-      x2 -> case (x2 .|. shiftRL x2 4) of-       x3 -> case (x3 .|. shiftRL x3 8) of-        x4 -> case (x4 .|. shiftRL x4 16) of-         x5 -> case (x5 .|. shiftRL x5 32) of   -- for 64 bit platforms-          x6 -> (x6 `xor` (shiftRL x6 1))
− System/Event/Internal.hs 
@@ -1,139 +0,0 @@-{-# LANGUAGE ExistentialQuantification, NoImplicitPrelude #-}--module System.Event.Internal-    (-    -- * Event back end-      Backend-    , backend-    , delete-    , poll-    , modifyFd-    -- * Event type-    , Event-    , evtRead-    , evtWrite-    , evtClose-    , eventIs-    -- * Timeout type-    , Timeout(..)-    -- * Helpers-    , throwErrnoIfMinus1NoRetry-    ) where--import Data.Bits ((.|.), (.&.))-import Data.List (foldl', intercalate)-import Data.Monoid (Monoid(..))-import Foreign.C.Error (eINTR, getErrno, throwErrno)-import System.Posix.Types (Fd)-import GHC.Base-import GHC.Num (Num(..))-import GHC.Show (Show(..))-import GHC.List (filter, null)---- | An I\/O event.-newtype Event = Event Int-    deriving (Eq)--evtNothing :: Event-evtNothing = Event 0-{-# INLINE evtNothing #-}---- | Data is available to be read.-evtRead :: Event-evtRead = Event 1-{-# INLINE evtRead #-}---- | The file descriptor is ready to accept a write.-evtWrite :: Event-evtWrite = Event 2-{-# INLINE evtWrite #-}---- | Another thread closed the file descriptor.-evtClose :: Event-evtClose = Event 4-{-# INLINE evtClose #-}--eventIs :: Event -> Event -> Bool-eventIs (Event a) (Event b) = a .&. b /= 0--instance Show Event where-    show e = '[' : (intercalate "," . filter (not . null) $-                    [evtRead `so` "evtRead",-                     evtWrite `so` "evtWrite",-                     evtClose `so` "evtClose"]) ++ "]"-        where ev `so` disp | e `eventIs` ev = disp-                           | otherwise      = ""--instance Monoid Event where-    mempty  = evtNothing-    mappend = evtCombine-    mconcat = evtConcat--evtCombine :: Event -> Event -> Event-evtCombine (Event a) (Event b) = Event (a .|. b)-{-# INLINE evtCombine #-}--evtConcat :: [Event] -> Event-evtConcat = foldl' evtCombine evtNothing-{-# INLINE evtConcat #-}---- | A type alias for timeouts, specified in seconds.-data Timeout = Timeout {-# UNPACK #-} !Double-             | Forever-               deriving (Show)---- | Event notification backend.-data Backend = forall a. Backend {-      _beState :: !a--    -- | Poll backend for new events.  The provided callback is called-    -- once per file descriptor with new events.-    , _bePoll :: a                          -- backend state-              -> Timeout                    -- timeout in milliseconds-              -> (Fd -> Event -> IO ())     -- I/O callback-              -> IO ()--    -- | Register, modify, or unregister interest in the given events-    -- on the given file descriptor.-    , _beModifyFd :: a-                  -> Fd       -- file descriptor-                  -> Event    -- old events to watch for ('mempty' for new)-                  -> Event    -- new events to watch for ('mempty' to delete)-                  -> IO ()--    , _beDelete :: a -> IO ()-    }--backend :: (a -> Timeout -> (Fd -> Event -> IO ()) -> IO ())-        -> (a -> Fd -> Event -> Event -> IO ())-        -> (a -> IO ())-        -> a-        -> Backend-backend bPoll bModifyFd bDelete state = Backend state bPoll bModifyFd bDelete-{-# INLINE backend #-}--poll :: Backend -> Timeout -> (Fd -> Event -> IO ()) -> IO ()-poll (Backend bState bPoll _ _) = bPoll bState-{-# INLINE poll #-}--modifyFd :: Backend -> Fd -> Event -> Event -> IO ()-modifyFd (Backend bState _ bModifyFd _) = bModifyFd bState-{-# INLINE modifyFd #-}--delete :: Backend -> IO ()-delete (Backend bState _ _ bDelete) = bDelete bState-{-# INLINE delete #-}---- | Throw an 'IOError' corresponding to the current value of--- 'getErrno' if the result value of the 'IO' action is -1 and--- 'getErrno' is not 'eINTR'.  If the result value is -1 and--- 'getErrno' returns 'eINTR' 0 is returned.  Otherwise the result--- value is returned.-throwErrnoIfMinus1NoRetry :: Num a => String -> IO a -> IO a-throwErrnoIfMinus1NoRetry loc f = do-    res <- f-    if res == -1-        then do-            err <- getErrno-            if err == eINTR then return 0 else throwErrno loc-        else return res
− System/Event/KQueue.hsc 
@@ -1,298 +0,0 @@-{-# LANGUAGE ForeignFunctionInterface, GeneralizedNewtypeDeriving,-    NoImplicitPrelude, RecordWildCards #-}--module System.Event.KQueue-    (-      new-    , available-    ) where--import qualified System.Event.Internal as E--#include "EventConfig.h"-#if !defined(HAVE_KQUEUE)-import GHC.Base--new :: IO E.Backend-new = error "KQueue back end not implemented for this platform"--available :: Bool-available = False-{-# INLINE available #-}-#else--import Control.Concurrent.MVar (MVar, newMVar, swapMVar, withMVar)-import Control.Monad (when, unless)-import Data.Bits (Bits(..))-import Data.Word (Word16, Word32)-import Foreign.C.Error (throwErrnoIfMinus1)-import Foreign.C.Types (CInt, CLong, CTime)-import Foreign.Marshal.Alloc (alloca)-import Foreign.Ptr (Ptr, nullPtr)-import Foreign.Storable (Storable(..))-import GHC.Base-import GHC.Enum (toEnum)-import GHC.Err (undefined)-import GHC.Num (Num(..))-import GHC.Real (ceiling, floor, fromIntegral)-import GHC.Show (Show(show))-import System.Event.Internal (Timeout(..))-import System.Posix.Internals (c_close)-import System.Posix.Types (Fd(..))-import qualified System.Event.Array as A--#if defined(HAVE_KEVENT64)-import Data.Int (Int64)-import Data.Word (Word64)-import Foreign.C.Types (CUInt)-#else-import Foreign.C.Types (CIntPtr, CUIntPtr)-#endif--#include <sys/types.h>-#include <sys/event.h>-#include <sys/time.h>---- Handle brokenness on some BSD variants, notably OS X up to at least--- 10.6.  If NOTE_EOF isn't available, we have no way to receive a--- notification from the kernel when we reach EOF on a plain file.-#ifndef NOTE_EOF-# define NOTE_EOF 0-#endif--available :: Bool-available = True-{-# INLINE available #-}----------------------------------------------------------------------------- Exported interface--data EventQueue = EventQueue {-      eqFd       :: {-# UNPACK #-} !QueueFd-    , eqChanges  :: {-# UNPACK #-} !(MVar (A.Array Event))-    , eqEvents   :: {-# UNPACK #-} !(A.Array Event)-    }--new :: IO E.Backend-new = do-  qfd <- kqueue-  changesArr <- A.empty-  changes <- newMVar changesArr -  events <- A.new 64-  let !be = E.backend poll modifyFd delete (EventQueue qfd changes events)-  return be--delete :: EventQueue -> IO ()-delete q = do-  _ <- c_close . fromQueueFd . eqFd $ q-  return ()--modifyFd :: EventQueue -> Fd -> E.Event -> E.Event -> IO ()-modifyFd q fd oevt nevt = withMVar (eqChanges q) $ \ch -> do-  let addChange filt flag = A.snoc ch $ event fd filt flag noteEOF-  when (oevt `E.eventIs` E.evtRead)  $ addChange filterRead flagDelete-  when (oevt `E.eventIs` E.evtWrite) $ addChange filterWrite flagDelete-  when (nevt `E.eventIs` E.evtRead)  $ addChange filterRead flagAdd-  when (nevt `E.eventIs` E.evtWrite) $ addChange filterWrite flagAdd--poll :: EventQueue-     -> Timeout-     -> (Fd -> E.Event -> IO ())-     -> IO ()-poll EventQueue{..} tout f = do-    changesArr <- A.empty-    changes <- swapMVar eqChanges changesArr-    changesLen <- A.length changes-    len <- A.length eqEvents-    when (changesLen > len) $ A.ensureCapacity eqEvents (2 * changesLen)-    n <- A.useAsPtr changes $ \changesPtr chLen ->-           A.unsafeLoad eqEvents $ \evPtr evCap ->-             withTimeSpec (fromTimeout tout) $-               kevent eqFd changesPtr chLen evPtr evCap--    unless (n == 0) $ do-        cap <- A.capacity eqEvents-        when (n == cap) $ A.ensureCapacity eqEvents (2 * cap)-        A.forM_ eqEvents $ \e -> f (fromIntegral (ident e)) (toEvent (filter e))----------------------------------------------------------------------------- FFI binding--newtype QueueFd = QueueFd {-      fromQueueFd :: CInt-    } deriving (Eq, Show)--#if defined(HAVE_KEVENT64)-data Event = KEvent64 {-      ident  :: {-# UNPACK #-} !Word64-    , filter :: {-# UNPACK #-} !Filter-    , flags  :: {-# UNPACK #-} !Flag-    , fflags :: {-# UNPACK #-} !FFlag-    , data_  :: {-# UNPACK #-} !Int64-    , udata  :: {-# UNPACK #-} !Word64-    , ext0   :: {-# UNPACK #-} !Word64-    , ext1   :: {-# UNPACK #-} !Word64-    } deriving Show--event :: Fd -> Filter -> Flag -> FFlag -> Event-event fd filt flag fflag = KEvent64 (fromIntegral fd) filt flag fflag 0 0 0 0--instance Storable Event where-    sizeOf _ = #size struct kevent64_s-    alignment _ = alignment (undefined :: CInt)--    peek ptr = do-        ident'  <- #{peek struct kevent64_s, ident} ptr-        filter' <- #{peek struct kevent64_s, filter} ptr-        flags'  <- #{peek struct kevent64_s, flags} ptr-        fflags' <- #{peek struct kevent64_s, fflags} ptr-        data'   <- #{peek struct kevent64_s, data} ptr-        udata'  <- #{peek struct kevent64_s, udata} ptr-        ext0'   <- #{peek struct kevent64_s, ext[0]} ptr-        ext1'   <- #{peek struct kevent64_s, ext[1]} ptr-        let !ev = KEvent64 ident' (Filter filter') (Flag flags') fflags' data'-                           udata' ext0' ext1'-        return ev--    poke ptr ev = do-        #{poke struct kevent64_s, ident} ptr (ident ev)-        #{poke struct kevent64_s, filter} ptr (filter ev)-        #{poke struct kevent64_s, flags} ptr (flags ev)-        #{poke struct kevent64_s, fflags} ptr (fflags ev)-        #{poke struct kevent64_s, data} ptr (data_ ev)-        #{poke struct kevent64_s, udata} ptr (udata ev)-        #{poke struct kevent64_s, ext[0]} ptr (ext0 ev)-        #{poke struct kevent64_s, ext[1]} ptr (ext1 ev)-#else-data Event = KEvent {-      ident  :: {-# UNPACK #-} !CUIntPtr-    , filter :: {-# UNPACK #-} !Filter-    , flags  :: {-# UNPACK #-} !Flag-    , fflags :: {-# UNPACK #-} !FFlag-    , data_  :: {-# UNPACK #-} !CIntPtr-    , udata  :: {-# UNPACK #-} !(Ptr ())-    } deriving Show--event :: Fd -> Filter -> Flag -> FFlag -> Event-event fd filt flag fflag = KEvent (fromIntegral fd) filt flag fflag 0 nullPtr--instance Storable Event where-    sizeOf _ = #size struct kevent-    alignment _ = alignment (undefined :: CInt)--    peek ptr = do-        ident'  <- #{peek struct kevent, ident} ptr-        filter' <- #{peek struct kevent, filter} ptr-        flags'  <- #{peek struct kevent, flags} ptr-        fflags' <- #{peek struct kevent, fflags} ptr-        data'   <- #{peek struct kevent, data} ptr-        udata'  <- #{peek struct kevent, udata} ptr-        let !ev = KEvent ident' (Filter filter') (Flag flags') fflags' data'-                         udata'-        return ev--    poke ptr ev = do-        #{poke struct kevent, ident} ptr (ident ev)-        #{poke struct kevent, filter} ptr (filter ev)-        #{poke struct kevent, flags} ptr (flags ev)-        #{poke struct kevent, fflags} ptr (fflags ev)-        #{poke struct kevent, data} ptr (data_ ev)-        #{poke struct kevent, udata} ptr (udata ev)-#endif--newtype FFlag = FFlag Word32-    deriving (Eq, Show, Storable)--#{enum FFlag, FFlag- , noteEOF = NOTE_EOF- }--newtype Flag = Flag Word16-    deriving (Eq, Show, Storable)--#{enum Flag, Flag- , flagAdd     = EV_ADD- , flagDelete  = EV_DELETE- }--newtype Filter = Filter Word16-    deriving (Bits, Eq, Num, Show, Storable)--#{enum Filter, Filter- , filterRead   = EVFILT_READ- , filterWrite  = EVFILT_WRITE- }--data TimeSpec = TimeSpec {-      tv_sec  :: {-# UNPACK #-} !CTime-    , tv_nsec :: {-# UNPACK #-} !CLong-    }--instance Storable TimeSpec where-    sizeOf _ = #size struct timespec-    alignment _ = alignment (undefined :: CInt)--    peek ptr = do-        tv_sec'  <- #{peek struct timespec, tv_sec} ptr-        tv_nsec' <- #{peek struct timespec, tv_nsec} ptr-        let !ts = TimeSpec tv_sec' tv_nsec'-        return ts--    poke ptr ts = do-        #{poke struct timespec, tv_sec} ptr (tv_sec ts)-        #{poke struct timespec, tv_nsec} ptr (tv_nsec ts)--kqueue :: IO QueueFd-kqueue = QueueFd `fmap` throwErrnoIfMinus1 "kqueue" c_kqueue---- TODO: We cannot retry on EINTR as the timeout would be wrong.--- Perhaps we should just return without calling any callbacks.-kevent :: QueueFd -> Ptr Event -> Int -> Ptr Event -> Int -> Ptr TimeSpec-       -> IO Int-kevent k chs chlen evs evlen ts-    = fmap fromIntegral $ E.throwErrnoIfMinus1NoRetry "kevent" $-#if defined(HAVE_KEVENT64)-      c_kevent64 k chs (fromIntegral chlen) evs (fromIntegral evlen) 0 ts-#else-      c_kevent k chs (fromIntegral chlen) evs (fromIntegral evlen) ts-#endif--withTimeSpec :: TimeSpec -> (Ptr TimeSpec -> IO a) -> IO a-withTimeSpec ts f =-    if tv_sec ts < 0 then-        f nullPtr-      else-        alloca $ \ptr -> poke ptr ts >> f ptr--fromTimeout :: Timeout -> TimeSpec-fromTimeout Forever     = TimeSpec (-1) (-1)-fromTimeout (Timeout s) = TimeSpec (toEnum sec) (toEnum nanosec)-  where-    sec :: Int-    sec     = floor s--    nanosec :: Int-    nanosec = ceiling $ (s - fromIntegral sec) * 1000000000--toEvent :: Filter -> E.Event-toEvent (Filter f)-    | f == (#const EVFILT_READ) = E.evtRead-    | f == (#const EVFILT_WRITE) = E.evtWrite-    | otherwise = error $ "toEvent: unknown filter " ++ show f--foreign import ccall unsafe "kqueue"-    c_kqueue :: IO CInt--#if defined(HAVE_KEVENT64)-foreign import ccall safe "kevent64"-    c_kevent64 :: QueueFd -> Ptr Event -> CInt -> Ptr Event -> CInt -> CUInt-               -> Ptr TimeSpec -> IO CInt-#elif defined(HAVE_KEVENT)-foreign import ccall safe "kevent"-    c_kevent :: QueueFd -> Ptr Event -> CInt -> Ptr Event -> CInt-             -> Ptr TimeSpec -> IO CInt-#else-#error no kevent system call available!?-#endif--#endif /* defined(HAVE_KQUEUE) */
− System/Event/Manager.hs 
@@ -1,402 +0,0 @@-{-# LANGUAGE BangPatterns, CPP, ExistentialQuantification, NoImplicitPrelude,-    RecordWildCards, TypeSynonymInstances #-}-module System.Event.Manager-    ( -- * Types-      EventManager--      -- * Creation-    , new-    , newWith-    , newDefaultBackend--      -- * Running-    , finished-    , loop-    , step-    , shutdown-    , cleanup-    , wakeManager--      -- * Registering interest in I/O events-    , Event-    , evtRead-    , evtWrite-    , IOCallback-    , FdKey(keyFd)-    , registerFd_-    , registerFd-    , unregisterFd_-    , unregisterFd-    , closeFd--      -- * Registering interest in timeout events-    , TimeoutCallback-    , TimeoutKey-    , registerTimeout-    , updateTimeout-    , unregisterTimeout-    ) where--#include "EventConfig.h"----------------------------------------------------------------------------- Imports--import Control.Concurrent.MVar (MVar, modifyMVar, newMVar, readMVar)-import Control.Exception (finally)-import Control.Monad ((=<<), forM_, liftM, sequence_, when)-import Data.IORef (IORef, atomicModifyIORef, mkWeakIORef, newIORef, readIORef,-                   writeIORef)-import Data.Maybe (Maybe(..))-import Data.Monoid (mappend, mconcat, mempty)-import GHC.Base-import GHC.Conc.Signal (runHandlers)-import GHC.List (filter)-import GHC.Num (Num(..))-import GHC.Real ((/), fromIntegral )-import GHC.Show (Show(..))-import System.Event.Clock (getCurrentTime)-import System.Event.Control-import System.Event.Internal (Backend, Event, evtClose, evtRead, evtWrite,-                              Timeout(..))-import System.Event.Unique (Unique, UniqueSource, newSource, newUnique)-import System.Posix.Types (Fd)--import qualified System.Event.IntMap as IM-import qualified System.Event.Internal as I-import qualified System.Event.PSQ as Q--#if defined(HAVE_KQUEUE)-import qualified System.Event.KQueue as KQueue-#elif defined(HAVE_EPOLL)-import qualified System.Event.EPoll  as EPoll-#elif defined(HAVE_POLL)-import qualified System.Event.Poll   as Poll-#else-# error not implemented for this operating system-#endif----------------------------------------------------------------------------- Types--data FdData = FdData {-      fdKey       :: {-# UNPACK #-} !FdKey-    , fdEvents    :: {-# UNPACK #-} !Event-    , _fdCallback :: !IOCallback-    } deriving (Show)---- | A file descriptor registration cookie.-data FdKey = FdKey {-      keyFd     :: {-# UNPACK #-} !Fd-    , keyUnique :: {-# UNPACK #-} !Unique-    } deriving (Eq, Show)---- | Callback invoked on I/O events.-type IOCallback = FdKey -> Event -> IO ()--instance Show IOCallback where-    show _ = "IOCallback"---- | A timeout registration cookie.-newtype TimeoutKey   = TK Unique-    deriving (Eq)---- | Callback invoked on timeout events.-type TimeoutCallback = IO ()--data State = Created-           | Running-           | Dying-           | Finished-             deriving (Eq, Show)---- | A priority search queue, with timeouts as priorities.-type TimeoutQueue = Q.PSQ TimeoutCallback--{--Instead of directly modifying the 'TimeoutQueue' in-e.g. 'registerTimeout' we keep a list of edits to perform, in the form-of a chain of function closures, and have the I/O manager thread-perform the edits later.  This exist to address the following GC-problem:--Since e.g. 'registerTimeout' doesn't force the evaluation of the-thunks inside the 'emTimeouts' IORef a number of thunks build up-inside the IORef.  If the I/O manager thread doesn't evaluate these-thunks soon enough they'll get promoted to the old generation and-become roots for all subsequent minor GCs.--When the thunks eventually get evaluated they will each create a new-intermediate 'TimeoutQueue' that immediately becomes garbage.  Since-the thunks serve as roots until the next major GC these intermediate-'TimeoutQueue's will get copied unnecesarily in the next minor GC,-increasing GC time.  This problem is known as "floating garbage".--Keeping a list of edits doesn't stop this from happening but makes the-amount of data that gets copied smaller.--TODO: Evaluate the content of the IORef to WHNF on each insert once-this bug is resolved: http://hackage.haskell.org/trac/ghc/ticket/3838--}---- | An edit to apply to a 'TimeoutQueue'.-type TimeoutEdit = TimeoutQueue -> TimeoutQueue---- | The event manager state.-data EventManager = EventManager-    { emBackend      :: !Backend-    , emFds          :: {-# UNPACK #-} !(MVar (IM.IntMap [FdData]))-    , emTimeouts     :: {-# UNPACK #-} !(IORef TimeoutEdit)-    , emState        :: {-# UNPACK #-} !(IORef State)-    , emUniqueSource :: {-# UNPACK #-} !UniqueSource-    , emControl      :: {-# UNPACK #-} !Control-    }----------------------------------------------------------------------------- Creation--handleControlEvent :: EventManager -> FdKey -> Event -> IO ()-handleControlEvent mgr reg _evt = do-  msg <- readControlMessage (emControl mgr) (keyFd reg)-  case msg of-    CMsgWakeup      -> return ()-    CMsgDie         -> writeIORef (emState mgr) Finished-    CMsgSignal fp s -> runHandlers fp s--newDefaultBackend :: IO Backend-#if defined(HAVE_KQUEUE)-newDefaultBackend = KQueue.new-#elif defined(HAVE_EPOLL)-newDefaultBackend = EPoll.new-#elif defined(HAVE_POLL)-newDefaultBackend = Poll.new-#else-newDefaultBackend = error "no back end for this platform"-#endif---- | Create a new event manager.-new :: IO EventManager-new = newWith =<< newDefaultBackend--newWith :: Backend -> IO EventManager-newWith be = do-  iofds <- newMVar IM.empty-  timeouts <- newIORef id-  ctrl <- newControl-  state <- newIORef Created-  us <- newSource-  _ <- mkWeakIORef state $ do-               st <- atomicModifyIORef state $ \s -> (Finished, s)-               when (st /= Finished) $ do-                 I.delete be-                 closeControl ctrl-  let mgr = EventManager { emBackend = be-                         , emFds = iofds-                         , emTimeouts = timeouts-                         , emState = state-                         , emUniqueSource = us-                         , emControl = ctrl-                         }-  _ <- registerFd_ mgr (handleControlEvent mgr) (controlReadFd ctrl) evtRead-  _ <- registerFd_ mgr (handleControlEvent mgr) (wakeupReadFd ctrl) evtRead-  return mgr---- | Asynchronously shuts down the event manager, if running.-shutdown :: EventManager -> IO ()-shutdown mgr = do-  state <- atomicModifyIORef (emState mgr) $ \s -> (Dying, s)-  when (state == Running) $ sendDie (emControl mgr)--finished :: EventManager -> IO Bool-finished mgr = (== Finished) `liftM` readIORef (emState mgr)--cleanup :: EventManager -> IO ()-cleanup EventManager{..} = do-  writeIORef emState Finished-  I.delete emBackend-  closeControl emControl----------------------------------------------------------------------------- Event loop---- | Start handling events.  This function loops until told to stop,--- using 'shutdown'.------ /Note/: This loop can only be run once per 'EventManager', as it--- closes all of its control resources when it finishes.-loop :: EventManager -> IO ()-loop mgr@EventManager{..} = do-  state <- atomicModifyIORef emState $ \s -> case s of-    Created -> (Running, s)-    _       -> (s, s)-  case state of-    Created -> go Q.empty `finally` cleanup mgr-    Dying   -> cleanup mgr-    _       -> do cleanup mgr-                  error $ "System.Event.Manager.loop: state is already " ++-                      show state- where-  go q = do (running, q') <- step mgr q-            when running $ go q'--step :: EventManager -> TimeoutQueue -> IO (Bool, TimeoutQueue)-step mgr@EventManager{..} tq = do-  (timeout, q') <- mkTimeout tq-  I.poll emBackend timeout (onFdEvent mgr)-  state <- readIORef emState-  state `seq` return (state == Running, q')- where--  -- | Call all expired timer callbacks and return the time to the-  -- next timeout.-  mkTimeout :: TimeoutQueue -> IO (Timeout, TimeoutQueue)-  mkTimeout q = do-      now <- getCurrentTime-      applyEdits <- atomicModifyIORef emTimeouts $ \f -> (id, f)-      let (expired, q'') = let q' = applyEdits q in q' `seq` Q.atMost now q'-      sequence_ $ map Q.value expired-      let timeout = case Q.minView q'' of-            Nothing             -> Forever-            Just (Q.E _ t _, _) ->-                -- This value will always be positive since the call-                -- to 'atMost' above removed any timeouts <= 'now'-                let t' = t - now in t' `seq` Timeout t'-      return (timeout, q'')----------------------------------------------------------------------------- Registering interest in I/O events---- | Register interest in the given events, without waking the event--- manager thread.  The 'Bool' return value indicates whether the--- event manager ought to be woken.-registerFd_ :: EventManager -> IOCallback -> Fd -> Event-            -> IO (FdKey, Bool)-registerFd_ EventManager{..} cb fd evs = do-  u <- newUnique emUniqueSource-  modifyMVar emFds $ \oldMap -> do-    let fd'  = fromIntegral fd-        reg  = FdKey fd u-        !fdd = FdData reg evs cb-        (!newMap, (oldEvs, newEvs)) =-            case IM.insertWith (++) fd' [fdd] oldMap of-              (Nothing,   n) -> (n, (mempty, evs))-              (Just prev, n) -> (n, pairEvents prev newMap fd')-        modify = oldEvs /= newEvs-    when modify $ I.modifyFd emBackend fd oldEvs newEvs-    return (newMap, (reg, modify))-{-# INLINE registerFd_ #-}---- | @registerFd mgr cb fd evs@ registers interest in the events @evs@--- on the file descriptor @fd@.  @cb@ is called for each event that--- occurs.  Returns a cookie that can be handed to 'unregisterFd'.-registerFd :: EventManager -> IOCallback -> Fd -> Event -> IO FdKey-registerFd mgr cb fd evs = do-  (r, wake) <- registerFd_ mgr cb fd evs-  when wake $ wakeManager mgr-  return r-{-# INLINE registerFd #-}---- | Wake up the event manager.-wakeManager :: EventManager -> IO ()-wakeManager mgr = sendWakeup (emControl mgr)--eventsOf :: [FdData] -> Event-eventsOf = mconcat . map fdEvents--pairEvents :: [FdData] -> IM.IntMap [FdData] -> Int -> (Event, Event)-pairEvents prev m fd = let l = eventsOf prev-                           r = case IM.lookup fd m of-                                 Nothing  -> mempty-                                 Just fds -> eventsOf fds-                       in (l, r)---- | Drop a previous file descriptor registration, without waking the--- event manager thread.  The return value indicates whether the event--- manager ought to be woken.-unregisterFd_ :: EventManager -> FdKey -> IO Bool-unregisterFd_ EventManager{..} (FdKey fd u) =-  modifyMVar emFds $ \oldMap -> do-    let dropReg cbs = case filter ((/= u) . keyUnique . fdKey) cbs of-                          []   -> Nothing-                          cbs' -> Just cbs'-        fd' = fromIntegral fd-        (!newMap, (oldEvs, newEvs)) =-            case IM.updateWith dropReg fd' oldMap of-              (Nothing,   _)    -> (oldMap, (mempty, mempty))-              (Just prev, newm) -> (newm, pairEvents prev newm fd')-        modify = oldEvs /= newEvs-    when modify $ I.modifyFd emBackend fd oldEvs newEvs-    return (newMap, modify)---- | Drop a previous file descriptor registration.-unregisterFd :: EventManager -> FdKey -> IO ()-unregisterFd mgr reg = do-  wake <- unregisterFd_ mgr reg-  when wake $ wakeManager mgr---- | Close a file descriptor in a race-safe way.-closeFd :: EventManager -> (Fd -> IO ()) -> Fd -> IO ()-closeFd mgr close fd = do-  fds <- modifyMVar (emFds mgr) $ \oldMap -> do-    close fd-    case IM.delete (fromIntegral fd) oldMap of-      (Nothing,  _)       -> return (oldMap, [])-      (Just fds, !newMap) -> do-        when (eventsOf fds /= mempty) $ wakeManager mgr-        return (newMap, fds)-  forM_ fds $ \(FdData reg ev cb) -> cb reg (ev `mappend` evtClose)----------------------------------------------------------------------------- Registering interest in timeout events---- | Register a timeout in the given number of microseconds.  The--- returned 'TimeoutKey' can be used to later unregister or update the--- timeout.  The timeout is automatically unregistered after the given--- time has passed.-registerTimeout :: EventManager -> Int -> TimeoutCallback -> IO TimeoutKey-registerTimeout mgr us cb = do-  !key <- newUnique (emUniqueSource mgr)-  if us <= 0 then cb-    else do-      now <- getCurrentTime-      let expTime = fromIntegral us / 1000000.0 + now--      -- We intentionally do not evaluate the modified map to WHNF here.-      -- Instead, we leave a thunk inside the IORef and defer its-      -- evaluation until mkTimeout in the event loop.  This is a-      -- workaround for a nasty IORef contention problem that causes the-      -- thread-delay benchmark to take 20 seconds instead of 0.2.-      atomicModifyIORef (emTimeouts mgr) $ \f ->-          let f' = (Q.insert key expTime cb) . f in (f', ())-      wakeManager mgr-  return $ TK key---- | Unregister an active timeout.-unregisterTimeout :: EventManager -> TimeoutKey -> IO ()-unregisterTimeout mgr (TK key) = do-  atomicModifyIORef (emTimeouts mgr) $ \f ->-      let f' = (Q.delete key) . f in (f', ())-  wakeManager mgr---- | Update an active timeout to fire in the given number of--- microseconds.-updateTimeout :: EventManager -> TimeoutKey -> Int -> IO ()-updateTimeout mgr (TK key) us = do-  now <- getCurrentTime-  let expTime = fromIntegral us / 1000000.0 + now--  atomicModifyIORef (emTimeouts mgr) $ \f ->-      let f' = (Q.adjust (const expTime) key) . f in (f', ())-  wakeManager mgr----------------------------------------------------------------------------- Utilities---- | Call the callbacks corresponding to the given file descriptor.-onFdEvent :: EventManager -> Fd -> Event -> IO ()-onFdEvent mgr fd evs = do-  fds <- readMVar (emFds mgr)-  case IM.lookup (fromIntegral fd) fds of-      Just cbs -> forM_ cbs $ \(FdData reg ev cb) ->-                    when (evs `I.eventIs` ev) $ cb reg evs-      Nothing  -> return ()
− System/Event/PSQ.hs 
@@ -1,483 +0,0 @@-{-# LANGUAGE BangPatterns, NoImplicitPrelude #-}---- Copyright (c) 2008, Ralf Hinze--- All rights reserved.------ Redistribution and use in source and binary forms, with or without--- modification, are permitted provided that the following conditions--- are met:------     * Redistributions of source code must retain the above---       copyright notice, this list of conditions and the following---       disclaimer.------     * Redistributions in binary form must reproduce the above---       copyright notice, this list of conditions and the following---       disclaimer in the documentation and/or other materials---       provided with the distribution.------     * The names of the contributors may not be used to endorse or---       promote products derived from this software without specific---       prior written permission.------ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS--- "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT--- LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS--- FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE--- COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,--- INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES--- (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR--- SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)--- HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,--- STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)--- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED--- OF THE POSSIBILITY OF SUCH DAMAGE.---- | A /priority search queue/ (henceforth /queue/) efficiently--- supports the operations of both a search tree and a priority queue.--- An 'Elem'ent is a product of a key, a priority, and a--- value. Elements can be inserted, deleted, modified and queried in--- logarithmic time, and the element with the least priority can be--- retrieved in constant time.  A queue can be built from a list of--- elements, sorted by keys, in linear time.------ This implementation is due to Ralf Hinze with some modifications by--- Scott Dillard and Johan Tibell.------ * Hinze, R., /A Simple Implementation Technique for Priority Search--- Queues/, ICFP 2001, pp. 110-121------ <http://citeseer.ist.psu.edu/hinze01simple.html>-module System.Event.PSQ-    (-    -- * Binding Type-    Elem(..)-    , Key-    , Prio--    -- * Priority Search Queue Type-    , PSQ--    -- * Query-    , size-    , null-    , lookup--    -- * Construction-    , empty-    , singleton--    -- * Insertion-    , insert--    -- * Delete/Update-    , delete-    , adjust--    -- * Conversion-    , toList-    , toAscList-    , toDescList-    , fromList--    -- * Min-    , findMin-    , deleteMin-    , minView-    , atMost-    ) where--import Data.Maybe (Maybe(..))-import GHC.Base-import GHC.Num (Num(..))-import GHC.Show (Show(showsPrec))-import System.Event.Unique (Unique)---- | @E k p@ binds the key @k@ with the priority @p@.-data Elem a = E-    { key   :: {-# UNPACK #-} !Key-    , prio  :: {-# UNPACK #-} !Prio-    , value :: a-    } deriving (Eq, Show)----------------------------------------------------------------------------- | A mapping from keys @k@ to priorites @p@.--type Prio = Double-type Key = Unique--data PSQ a = Void-           | Winner {-# UNPACK #-} !(Elem a)-                    !(LTree a)-                    {-# UNPACK #-} !Key  -- max key-           deriving (Eq, Show)---- | /O(1)/ The number of elements in a queue.-size :: PSQ a -> Int-size Void            = 0-size (Winner _ lt _) = 1 + size' lt---- | /O(1)/ True if the queue is empty.-null :: PSQ a -> Bool-null Void           = True-null (Winner _ _ _) = False---- | /O(log n)/ The priority and value of a given key, or Nothing if--- the key is not bound.-lookup :: Key -> PSQ a -> Maybe (Prio, a)-lookup k q = case tourView q of-    Null -> Nothing-    Single (E k' p v)-        | k == k'   -> Just (p, v)-        | otherwise -> Nothing-    tl `Play` tr-        | k <= maxKey tl -> lookup k tl-        | otherwise      -> lookup k tr----------------------------------------------------------------------------- Construction--empty :: PSQ a-empty = Void---- | /O(1)/ Build a queue with one element.-singleton :: Key -> Prio -> a -> PSQ a-singleton k p v = Winner (E k p v) Start k----------------------------------------------------------------------------- Insertion---- | /O(log n)/ Insert a new key, priority and value in the queue.  If--- the key is already present in the queue, the associated priority--- and value are replaced with the supplied priority and value.-insert :: Key -> Prio -> a -> PSQ a -> PSQ a-insert k p v q = case q of-    Void -> singleton k p v-    Winner (E k' p' v') Start _ -> case compare k k' of-        LT -> singleton k  p  v  `play` singleton k' p' v'-        EQ -> singleton k  p  v-        GT -> singleton k' p' v' `play` singleton k  p  v-    Winner e (RLoser _ e' tl m tr) m'-        | k <= m    -> insert k p v (Winner e tl m) `play` (Winner e' tr m')-        | otherwise -> (Winner e tl m) `play` insert k p v (Winner e' tr m')-    Winner e (LLoser _ e' tl m tr) m'-        | k <= m    -> insert k p v (Winner e' tl m) `play` (Winner e tr m')-        | otherwise -> (Winner e' tl m) `play` insert k p v (Winner e tr m')----------------------------------------------------------------------------- Delete/Update---- | /O(log n)/ Delete a key and its priority and value from the--- queue.  When the key is not a member of the queue, the original--- queue is returned.-delete :: Key -> PSQ a -> PSQ a-delete k q = case q of-    Void -> empty-    Winner (E k' p v) Start _-        | k == k'   -> empty-        | otherwise -> singleton k' p v-    Winner e (RLoser _ e' tl m tr) m'-        | k <= m    -> delete k (Winner e tl m) `play` (Winner e' tr m')-        | otherwise -> (Winner e tl m) `play` delete k (Winner e' tr m')-    Winner e (LLoser _ e' tl m tr) m'-        | k <= m    -> delete k (Winner e' tl m) `play` (Winner e tr m')-        | otherwise -> (Winner e' tl m) `play` delete k (Winner e tr m')---- | /O(log n)/ Update a priority at a specific key with the result--- of the provided function.  When the key is not a member of the--- queue, the original queue is returned.-adjust :: (Prio -> Prio) -> Key -> PSQ a -> PSQ a-adjust f k q0 =  go q0-  where-    go q = case q of-        Void -> empty-        Winner (E k' p v) Start _-            | k == k'   -> singleton k' (f p) v-            | otherwise -> singleton k' p v-        Winner e (RLoser _ e' tl m tr) m'-            | k <= m    -> go (Winner e tl m) `unsafePlay` (Winner e' tr m')-            | otherwise -> (Winner e tl m) `unsafePlay` go (Winner e' tr m')-        Winner e (LLoser _ e' tl m tr) m'-            | k <= m    -> go (Winner e' tl m) `unsafePlay` (Winner e tr m')-            | otherwise -> (Winner e' tl m) `unsafePlay` go (Winner e tr m')-{-# INLINE adjust #-}----------------------------------------------------------------------------- Conversion---- | /O(n*log n)/ Build a queue from a list of key/priority/value--- tuples.  If the list contains more than one priority and value for--- the same key, the last priority and value for the key is retained.-fromList :: [Elem a] -> PSQ a-fromList = foldr (\(E k p v) q -> insert k p v q) empty---- | /O(n)/ Convert to a list of key/priority/value tuples.-toList :: PSQ a -> [Elem a]-toList = toAscList---- | /O(n)/ Convert to an ascending list.-toAscList :: PSQ a -> [Elem a]-toAscList q  = seqToList (toAscLists q)--toAscLists :: PSQ a -> Sequ (Elem a)-toAscLists q = case tourView q of-    Null         -> emptySequ-    Single e     -> singleSequ e-    tl `Play` tr -> toAscLists tl <> toAscLists tr---- | /O(n)/ Convert to a descending list.-toDescList :: PSQ a -> [ Elem a ]-toDescList q = seqToList (toDescLists q)--toDescLists :: PSQ a -> Sequ (Elem a)-toDescLists q = case tourView q of-    Null         -> emptySequ-    Single e     -> singleSequ e-    tl `Play` tr -> toDescLists tr <> toDescLists tl----------------------------------------------------------------------------- Min---- | /O(1)/ The element with the lowest priority.-findMin :: PSQ a -> Maybe (Elem a)-findMin Void           = Nothing-findMin (Winner e _ _) = Just e---- | /O(log n)/ Delete the element with the lowest priority.  Returns--- an empty queue if the queue is empty.-deleteMin :: PSQ a -> PSQ a-deleteMin Void           = Void-deleteMin (Winner _ t m) = secondBest t m---- | /O(log n)/ Retrieve the binding with the least priority, and the--- rest of the queue stripped of that binding.-minView :: PSQ a -> Maybe (Elem a, PSQ a)-minView Void           = Nothing-minView (Winner e t m) = Just (e, secondBest t m)--secondBest :: LTree a -> Key -> PSQ a-secondBest Start _                 = Void-secondBest (LLoser _ e tl m tr) m' = Winner e tl m `play` secondBest tr m'-secondBest (RLoser _ e tl m tr) m' = secondBest tl m `play` Winner e tr m'---- | /O(r*(log n - log r))/ Return a list of elements ordered by--- key whose priorities are at most @pt@.-atMost :: Prio -> PSQ a -> ([Elem a], PSQ a)-atMost pt q = let (sequ, q') = atMosts pt q-              in (seqToList sequ, q')--atMosts :: Prio -> PSQ a -> (Sequ (Elem a), PSQ a)-atMosts !pt q = case q of-    (Winner e _ _)-        | prio e > pt -> (emptySequ, q)-    Void              -> (emptySequ, Void)-    Winner e Start _  -> (singleSequ e, Void)-    Winner e (RLoser _ e' tl m tr) m' ->-        let (sequ, q')   = atMosts pt (Winner e tl m)-            (sequ', q'') = atMosts pt (Winner e' tr m')-        in (sequ <> sequ', q' `play` q'')-    Winner e (LLoser _ e' tl m tr) m' ->-        let (sequ, q')   = atMosts pt (Winner e' tl m)-            (sequ', q'') = atMosts pt (Winner e tr m')-        in (sequ <> sequ', q' `play` q'')----------------------------------------------------------------------------- Loser tree--type Size = Int--data LTree a = Start-             | LLoser {-# UNPACK #-} !Size-                      {-# UNPACK #-} !(Elem a)-                      !(LTree a)-                      {-# UNPACK #-} !Key  -- split key-                      !(LTree a)-             | RLoser {-# UNPACK #-} !Size-                      {-# UNPACK #-} !(Elem a)-                      !(LTree a)-                      {-# UNPACK #-} !Key  -- split key-                      !(LTree a)-             deriving (Eq, Show)--size' :: LTree a -> Size-size' Start              = 0-size' (LLoser s _ _ _ _) = s-size' (RLoser s _ _ _ _) = s--left, right :: LTree a -> LTree a--left Start                = moduleError "left" "empty loser tree"-left (LLoser _ _ tl _ _ ) = tl-left (RLoser _ _ tl _ _ ) = tl--right Start                = moduleError "right" "empty loser tree"-right (LLoser _ _ _  _ tr) = tr-right (RLoser _ _ _  _ tr) = tr--maxKey :: PSQ a -> Key-maxKey Void           = moduleError "maxKey" "empty queue"-maxKey (Winner _ _ m) = m--lloser, rloser :: Key -> Prio -> a -> LTree a -> Key -> LTree a -> LTree a-lloser k p v tl m tr = LLoser (1 + size' tl + size' tr) (E k p v) tl m tr-rloser k p v tl m tr = RLoser (1 + size' tl + size' tr) (E k p v) tl m tr----------------------------------------------------------------------------- Balancing---- | Balance factor-omega :: Int-omega = 4--lbalance, rbalance :: Key -> Prio -> a -> LTree a -> Key -> LTree a -> LTree a--lbalance k p v l m r-    | size' l + size' r < 2     = lloser        k p v l m r-    | size' r > omega * size' l = lbalanceLeft  k p v l m r-    | size' l > omega * size' r = lbalanceRight k p v l m r-    | otherwise                 = lloser        k p v l m r--rbalance k p v l m r-    | size' l + size' r < 2     = rloser        k p v l m r-    | size' r > omega * size' l = rbalanceLeft  k p v l m r-    | size' l > omega * size' r = rbalanceRight k p v l m r-    | otherwise                 = rloser        k p v l m r--lbalanceLeft :: Key -> Prio -> a -> LTree a -> Key -> LTree a -> LTree a-lbalanceLeft  k p v l m r-    | size' (left r) < size' (right r) = lsingleLeft  k p v l m r-    | otherwise                        = ldoubleLeft  k p v l m r--lbalanceRight :: Key -> Prio -> a -> LTree a -> Key -> LTree a -> LTree a-lbalanceRight k p v l m r-    | size' (left l) > size' (right l) = lsingleRight k p v l m r-    | otherwise                        = ldoubleRight k p v l m r--rbalanceLeft :: Key -> Prio -> a -> LTree a -> Key -> LTree a -> LTree a-rbalanceLeft  k p v l m r-    | size' (left r) < size' (right r) = rsingleLeft  k p v l m r-    | otherwise                        = rdoubleLeft  k p v l m r--rbalanceRight :: Key -> Prio -> a -> LTree a -> Key -> LTree a -> LTree a-rbalanceRight k p v l m r-    | size' (left l) > size' (right l) = rsingleRight k p v l m r-    | otherwise                        = rdoubleRight k p v l m r--lsingleLeft :: Key -> Prio -> a -> LTree a -> Key -> LTree a -> LTree a-lsingleLeft k1 p1 v1 t1 m1 (LLoser _ (E k2 p2 v2) t2 m2 t3)-    | p1 <= p2  = lloser k1 p1 v1 (rloser k2 p2 v2 t1 m1 t2) m2 t3-    | otherwise = lloser k2 p2 v2 (lloser k1 p1 v1 t1 m1 t2) m2 t3-lsingleLeft k1 p1 v1 t1 m1 (RLoser _ (E k2 p2 v2) t2 m2 t3) =-    rloser k2 p2 v2 (lloser k1 p1 v1 t1 m1 t2) m2 t3-lsingleLeft _ _ _ _ _ _ = moduleError "lsingleLeft" "malformed tree"--rsingleLeft :: Key -> Prio -> a -> LTree a -> Key -> LTree a -> LTree a-rsingleLeft k1 p1 v1 t1 m1 (LLoser _ (E k2 p2 v2) t2 m2 t3) =-    rloser k1 p1 v1 (rloser k2 p2 v2 t1 m1 t2) m2 t3-rsingleLeft k1 p1 v1 t1 m1 (RLoser _ (E k2 p2 v2) t2 m2 t3) =-    rloser k2 p2 v2 (rloser k1 p1 v1 t1 m1 t2) m2 t3-rsingleLeft _ _ _ _ _ _ = moduleError "rsingleLeft" "malformed tree"--lsingleRight :: Key -> Prio -> a -> LTree a -> Key -> LTree a -> LTree a-lsingleRight k1 p1 v1 (LLoser _ (E k2 p2 v2) t1 m1 t2) m2 t3 =-    lloser k2 p2 v2 t1 m1 (lloser k1 p1 v1 t2 m2 t3)-lsingleRight k1 p1 v1 (RLoser _ (E k2 p2 v2) t1 m1 t2) m2 t3 =-    lloser k1 p1 v1 t1 m1 (lloser k2 p2 v2 t2 m2 t3)-lsingleRight _ _ _ _ _ _ = moduleError "lsingleRight" "malformed tree"--rsingleRight :: Key -> Prio -> a -> LTree a -> Key -> LTree a -> LTree a-rsingleRight k1 p1 v1 (LLoser _ (E k2 p2 v2) t1 m1 t2) m2 t3 =-    lloser k2 p2 v2 t1 m1 (rloser k1 p1 v1 t2 m2 t3)-rsingleRight k1 p1 v1 (RLoser _ (E k2 p2 v2) t1 m1 t2) m2 t3-    | p1 <= p2  = rloser k1 p1 v1 t1 m1 (lloser k2 p2 v2 t2 m2 t3)-    | otherwise = rloser k2 p2 v2 t1 m1 (rloser k1 p1 v1 t2 m2 t3)-rsingleRight _ _ _ _ _ _ = moduleError "rsingleRight" "malformed tree"--ldoubleLeft :: Key -> Prio -> a -> LTree a -> Key -> LTree a -> LTree a-ldoubleLeft k1 p1 v1 t1 m1 (LLoser _ (E k2 p2 v2) t2 m2 t3) =-    lsingleLeft k1 p1 v1 t1 m1 (lsingleRight k2 p2 v2 t2 m2 t3)-ldoubleLeft k1 p1 v1 t1 m1 (RLoser _ (E k2 p2 v2) t2 m2 t3) =-    lsingleLeft k1 p1 v1 t1 m1 (rsingleRight k2 p2 v2 t2 m2 t3)-ldoubleLeft _ _ _ _ _ _ = moduleError "ldoubleLeft" "malformed tree"--ldoubleRight :: Key -> Prio -> a -> LTree a -> Key -> LTree a -> LTree a-ldoubleRight k1 p1 v1 (LLoser _ (E k2 p2 v2) t1 m1 t2) m2 t3 =-    lsingleRight k1 p1 v1 (lsingleLeft k2 p2 v2 t1 m1 t2) m2 t3-ldoubleRight k1 p1 v1 (RLoser _ (E k2 p2 v2) t1 m1 t2) m2 t3 =-    lsingleRight k1 p1 v1 (rsingleLeft k2 p2 v2 t1 m1 t2) m2 t3-ldoubleRight _ _ _ _ _ _ = moduleError "ldoubleRight" "malformed tree"--rdoubleLeft :: Key -> Prio -> a -> LTree a -> Key -> LTree a -> LTree a-rdoubleLeft k1 p1 v1 t1 m1 (LLoser _ (E k2 p2 v2) t2 m2 t3) =-    rsingleLeft k1 p1 v1 t1 m1 (lsingleRight k2 p2 v2 t2 m2 t3)-rdoubleLeft k1 p1 v1 t1 m1 (RLoser _ (E k2 p2 v2) t2 m2 t3) =-    rsingleLeft k1 p1 v1 t1 m1 (rsingleRight k2 p2 v2 t2 m2 t3)-rdoubleLeft _ _ _ _ _ _ = moduleError "rdoubleLeft" "malformed tree"--rdoubleRight :: Key -> Prio -> a -> LTree a -> Key -> LTree a -> LTree a-rdoubleRight k1 p1 v1 (LLoser _ (E k2 p2 v2) t1 m1 t2) m2 t3 =-    rsingleRight k1 p1 v1 (lsingleLeft k2 p2 v2 t1 m1 t2) m2 t3-rdoubleRight k1 p1 v1 (RLoser _ (E k2 p2 v2) t1 m1 t2) m2 t3 =-    rsingleRight k1 p1 v1 (rsingleLeft k2 p2 v2 t1 m1 t2) m2 t3-rdoubleRight _ _ _ _ _ _ = moduleError "rdoubleRight" "malformed tree"---- | Take two pennants and returns a new pennant that is the union of--- the two with the precondition that the keys in the first tree are--- strictly smaller than the keys in the second tree.-play :: PSQ a -> PSQ a -> PSQ a-Void `play` t' = t'-t `play` Void  = t-Winner e@(E k p v) t m `play` Winner e'@(E k' p' v') t' m'-    | p <= p'   = Winner e (rbalance k' p' v' t m t') m'-    | otherwise = Winner e' (lbalance k p v t m t') m'-{-# INLINE play #-}---- | A version of 'play' that can be used if the shape of the tree has--- not changed or if the tree is known to be balanced.-unsafePlay :: PSQ a -> PSQ a -> PSQ a-Void `unsafePlay` t' =  t'-t `unsafePlay` Void  =  t-Winner e@(E k p v) t m `unsafePlay` Winner e'@(E k' p' v') t' m'-    | p <= p'   = Winner e (rloser k' p' v' t m t') m'-    | otherwise = Winner e' (lloser k p v t m t') m'-{-# INLINE unsafePlay #-}--data TourView a = Null-                | Single {-# UNPACK #-} !(Elem a)-                | (PSQ a) `Play` (PSQ a)--tourView :: PSQ a -> TourView a-tourView Void               = Null-tourView (Winner e Start _) = Single e-tourView (Winner e (RLoser _ e' tl m tr) m') =-    Winner e tl m `Play` Winner e' tr m'-tourView (Winner e (LLoser _ e' tl m tr) m') =-    Winner e' tl m `Play` Winner e tr m'----------------------------------------------------------------------------- Utility functions--moduleError :: String -> String -> a-moduleError fun msg = error ("System.Event.PSQ." ++ fun ++ ':' : ' ' : msg)-{-# NOINLINE moduleError #-}----------------------------------------------------------------------------- Hughes's efficient sequence type--newtype Sequ a = Sequ ([a] -> [a])--emptySequ :: Sequ a-emptySequ = Sequ (\as -> as)--singleSequ :: a -> Sequ a-singleSequ a = Sequ (\as -> a : as)--(<>) :: Sequ a -> Sequ a -> Sequ a-Sequ x1 <> Sequ x2 = Sequ (\as -> x1 (x2 as))-infixr 5 <>--seqToList :: Sequ a -> [a]-seqToList (Sequ x) = x []--instance Show a => Show (Sequ a) where-    showsPrec d a = showsPrec d (seqToList a)
− System/Event/Poll.hsc 
@@ -1,149 +0,0 @@-{-# LANGUAGE ForeignFunctionInterface, GeneralizedNewtypeDeriving,-    NoImplicitPrelude #-}--module System.Event.Poll-    (-      new-    , available-    ) where--#include "EventConfig.h"--#if !defined(HAVE_POLL_H)-import GHC.Base--new :: IO E.Backend-new = error "Poll back end not implemented for this platform"--available :: Bool-available = False-{-# INLINE available #-}-#else-#include <poll.h>--import Control.Concurrent.MVar (MVar, newMVar, swapMVar)-import Control.Monad ((=<<), liftM, liftM2, unless)-import Data.Bits (Bits, (.|.), (.&.))-import Data.Maybe (Maybe(..))-import Data.Monoid (Monoid(..))-import Foreign.C.Types (CInt, CShort, CULong)-import Foreign.Ptr (Ptr)-import Foreign.Storable (Storable(..))-import GHC.Base-import GHC.Conc.Sync (withMVar)-import GHC.Err (undefined)-import GHC.Num (Num(..))-import GHC.Real (ceiling, fromIntegral)-import GHC.Show (Show)-import System.Posix.Types (Fd(..))--import qualified System.Event.Array as A-import qualified System.Event.Internal as E--available :: Bool-available = True-{-# INLINE available #-}--data Poll = Poll {-      pollChanges :: {-# UNPACK #-} !(MVar (A.Array PollFd))-    , pollFd      :: {-# UNPACK #-} !(A.Array PollFd)-    }--new :: IO E.Backend-new = E.backend poll modifyFd (\_ -> return ()) `liftM`-      liftM2 Poll (newMVar =<< A.empty) A.empty--modifyFd :: Poll -> Fd -> E.Event -> E.Event -> IO ()-modifyFd p fd oevt nevt =-  withMVar (pollChanges p) $ \ary ->-    A.snoc ary $ PollFd fd (fromEvent nevt) (fromEvent oevt)--reworkFd :: Poll -> PollFd -> IO ()-reworkFd p (PollFd fd npevt opevt) = do-  let ary = pollFd p-  if opevt == 0-    then A.snoc ary $ PollFd fd npevt 0-    else do-      found <- A.findIndex ((== fd) . pfdFd) ary-      case found of-        Nothing        -> error "reworkFd: event not found"-        Just (i,_)-          | npevt /= 0 -> A.unsafeWrite ary i $ PollFd fd npevt 0-          | otherwise  -> A.removeAt ary i--poll :: Poll-     -> E.Timeout-     -> (Fd -> E.Event -> IO ())-     -> IO ()-poll p tout f = do-  let a = pollFd p-  mods <- swapMVar (pollChanges p) =<< A.empty-  A.forM_ mods (reworkFd p)-  n <- A.useAsPtr a $ \ptr len -> E.throwErrnoIfMinus1NoRetry "c_poll" $-         c_poll ptr (fromIntegral len) (fromIntegral (fromTimeout tout))-  unless (n == 0) $ do-    A.loop a 0 $ \i e -> do-      let r = pfdRevents e-      if r /= 0-        then do f (pfdFd e) (toEvent r)-                let i' = i + 1-                return (i', i' == n)-        else return (i, True)--fromTimeout :: E.Timeout -> Int-fromTimeout E.Forever     = -1-fromTimeout (E.Timeout s) = ceiling $ 1000 * s--data PollFd = PollFd {-      pfdFd      :: {-# UNPACK #-} !Fd-    , pfdEvents  :: {-# UNPACK #-} !Event-    , pfdRevents :: {-# UNPACK #-} !Event-    } deriving (Show)--newtype Event = Event CShort-    deriving (Eq, Show, Num, Storable, Bits)--#{enum Event, Event- , pollIn    = POLLIN- , pollOut   = POLLOUT-#ifdef POLLRDHUP- , pollRdHup = POLLRDHUP-#endif- , pollErr   = POLLERR- , pollHup   = POLLHUP- }--fromEvent :: E.Event -> Event-fromEvent e = remap E.evtRead  pollIn .|.-              remap E.evtWrite pollOut-  where remap evt to-            | e `E.eventIs` evt = to-            | otherwise         = 0--toEvent :: Event -> E.Event-toEvent e = remap (pollIn .|. pollErr .|. pollHup)  E.evtRead `mappend`-            remap (pollOut .|. pollErr .|. pollHup) E.evtWrite-  where remap evt to-            | e .&. evt /= 0 = to-            | otherwise      = mempty--instance Storable PollFd where-    sizeOf _    = #size struct pollfd-    alignment _ = alignment (undefined :: CInt)--    peek ptr = do-      fd <- #{peek struct pollfd, fd} ptr-      events <- #{peek struct pollfd, events} ptr-      revents <- #{peek struct pollfd, revents} ptr-      let !pollFd' = PollFd fd events revents-      return pollFd'--    poke ptr p = do-      #{poke struct pollfd, fd} ptr (pfdFd p)-      #{poke struct pollfd, events} ptr (pfdEvents p)-      #{poke struct pollfd, revents} ptr (pfdRevents p)--foreign import ccall safe "poll.h poll"-    c_poll :: Ptr PollFd -> CULong -> CInt -> IO CInt--#endif /* defined(HAVE_POLL_H) */
− System/Event/Thread.hs 
@@ -1,143 +0,0 @@-{-# LANGUAGE BangPatterns, ForeignFunctionInterface, NoImplicitPrelude #-}--module System.Event.Thread-    (-      ensureIOManagerIsRunning-    , threadWaitRead-    , threadWaitWrite-    , closeFdWith-    , threadDelay-    , registerDelay-    ) where--import Data.IORef (IORef, newIORef, readIORef, writeIORef)-import Data.Maybe (Maybe(..))-import Foreign.C.Error (eBADF, errnoToIOError)-import Foreign.Ptr (Ptr)-import GHC.Base-import GHC.Conc.Sync (TVar, ThreadId, ThreadStatus(..), atomically, forkIO,-                      labelThread, modifyMVar_, newTVar, sharedCAF,-                      threadStatus, writeTVar)-import GHC.IO (mask_, onException)-import GHC.IO.Exception (ioError)-import GHC.MVar (MVar, newEmptyMVar, newMVar, putMVar, takeMVar)-import System.Event.Internal (eventIs, evtClose)-import System.Event.Manager (Event, EventManager, evtRead, evtWrite, loop,-                             new, registerFd, unregisterFd_, registerTimeout)-import qualified System.Event.Manager as M-import System.IO.Unsafe (unsafePerformIO)-import System.Posix.Types (Fd)---- | Suspends the current thread for a given number of microseconds--- (GHC only).------ There is no guarantee that the thread will be rescheduled promptly--- when the delay has expired, but the thread will never continue to--- run /earlier/ than specified.-threadDelay :: Int -> IO ()-threadDelay usecs = mask_ $ do-  Just mgr <- readIORef eventManager-  m <- newEmptyMVar-  reg <- registerTimeout mgr usecs (putMVar m ())-  takeMVar m `onException` M.unregisterTimeout mgr reg---- | Set the value of returned TVar to True after a given number of--- microseconds. The caveats associated with threadDelay also apply.----registerDelay :: Int -> IO (TVar Bool)-registerDelay usecs = do-  t <- atomically $ newTVar False-  Just mgr <- readIORef eventManager-  _ <- registerTimeout mgr usecs . atomically $ writeTVar t True-  return t---- | Block the current thread until data is available to read from the--- given file descriptor.------ This will throw an 'IOError' if the file descriptor was closed--- while this thread was blocked.  To safely close a file descriptor--- that has been used with 'threadWaitRead', use 'closeFdWith'.-threadWaitRead :: Fd -> IO ()-threadWaitRead = threadWait evtRead-{-# INLINE threadWaitRead #-}---- | Block the current thread until the given file descriptor can--- accept data to write.------ This will throw an 'IOError' if the file descriptor was closed--- while this thread was blocked.  To safely close a file descriptor--- that has been used with 'threadWaitWrite', use 'closeFdWith'.-threadWaitWrite :: Fd -> IO ()-threadWaitWrite = threadWait evtWrite-{-# INLINE threadWaitWrite #-}---- | Close a file descriptor in a concurrency-safe way.------ Any threads that are blocked on the file descriptor via--- 'threadWaitRead' or 'threadWaitWrite' will be unblocked by having--- IO exceptions thrown.-closeFdWith :: (Fd -> IO ())        -- ^ Action that performs the close.-            -> Fd                   -- ^ File descriptor to close.-            -> IO ()-closeFdWith close fd = do-  Just mgr <- readIORef eventManager-  M.closeFd mgr close fd--threadWait :: Event -> Fd -> IO ()-threadWait evt fd = mask_ $ do-  m <- newEmptyMVar-  Just mgr <- readIORef eventManager-  reg <- registerFd mgr (\reg e -> unregisterFd_ mgr reg >> putMVar m e) fd evt-  evt' <- takeMVar m `onException` unregisterFd_ mgr reg-  if evt' `eventIs` evtClose-    then ioError $ errnoToIOError "threadWait" eBADF Nothing Nothing-    else return ()--foreign import ccall unsafe "getOrSetSystemEventThreadEventManagerStore"-    getOrSetSystemEventThreadEventManagerStore :: Ptr a -> IO (Ptr a)--eventManager :: IORef (Maybe EventManager)-eventManager = unsafePerformIO $ do-    em <- newIORef Nothing-    sharedCAF em getOrSetSystemEventThreadEventManagerStore-{-# NOINLINE eventManager #-}--foreign import ccall unsafe "getOrSetSystemEventThreadIOManagerThreadStore"-    getOrSetSystemEventThreadIOManagerThreadStore :: Ptr a -> IO (Ptr a)--{-# NOINLINE ioManager #-}-ioManager :: MVar (Maybe ThreadId)-ioManager = unsafePerformIO $ do-   m <- newMVar Nothing-   sharedCAF m getOrSetSystemEventThreadIOManagerThreadStore--ensureIOManagerIsRunning :: IO ()-ensureIOManagerIsRunning-  | not threaded = return ()-  | otherwise = modifyMVar_ ioManager $ \old -> do-  let create = do-        !mgr <- new-        writeIORef eventManager $ Just mgr-        !t <- forkIO $ loop mgr-        labelThread t "IOManager"-        return $ Just t-  case old of-    Nothing            -> create-    st@(Just t) -> do-      s <- threadStatus t-      case s of-        ThreadFinished -> create-        ThreadDied     -> do -          -- Sanity check: if the thread has died, there is a chance-          -- that event manager is still alive. This could happend during-          -- the fork, for example. In this case we should clean up-          -- open pipes and everything else related to the event manager.-          -- See #4449-          mem <- readIORef eventManager-          _ <- case mem of-                 Nothing -> return ()-                 Just em -> M.cleanup em-          create-        _other         -> return st--foreign import ccall unsafe "rtsSupportsBoundThreads" threaded :: Bool
− System/Event/Unique.hs 
@@ -1,40 +0,0 @@-{-# LANGUAGE BangPatterns, GeneralizedNewtypeDeriving, NoImplicitPrelude #-}-module System.Event.Unique-    (-      UniqueSource-    , Unique(..)-    , newSource-    , newUnique-    ) where--import Data.Int (Int64)-import GHC.Base-import GHC.Conc.Sync (TVar, atomically, newTVarIO, readTVar, writeTVar)-import GHC.Num (Num(..))-import GHC.Show (Show(..))---- We used to use IORefs here, but Simon switched us to STM when we--- found that our use of atomicModifyIORef was subject to a severe RTS--- performance problem when used in a tight loop from multiple--- threads: http://hackage.haskell.org/trac/ghc/ticket/3838------ There seems to be no performance cost to using a TVar instead.--newtype UniqueSource = US (TVar Int64)--newtype Unique = Unique { asInt64 :: Int64 }-    deriving (Eq, Ord, Num)--instance Show Unique where-    show = show . asInt64--newSource :: IO UniqueSource-newSource = US `fmap` newTVarIO 0--newUnique :: UniqueSource -> IO Unique-newUnique (US ref) = atomically $ do-  u <- readTVar ref-  let !u' = u+1-  writeTVar ref u'-  return $ Unique u'-{-# INLINE newUnique #-}
System/Exit.hs view
@@ -1,3 +1,6 @@+{-# LANGUAGE Trustworthy #-}+{-# LANGUAGE CPP #-}+ ----------------------------------------------------------------------------- -- | -- Module      :  System.Exit
System/IO.hs view
@@ -1,4 +1,6 @@-{-# OPTIONS_GHC -XNoImplicitPrelude #-}+{-# LANGUAGE Trustworthy #-}+{-# LANGUAGE CPP, NoImplicitPrelude #-}+ ----------------------------------------------------------------------------- -- | -- Module      :  System.IO@@ -200,6 +202,7 @@     utf16, utf16le, utf16be,     utf32, utf32le, utf32be,      localeEncoding,+    char8,     mkTextEncoding, #endif @@ -244,7 +247,7 @@  #ifdef __GLASGOW_HASKELL__ import GHC.Base-import GHC.IO hiding ( onException )+import GHC.IO hiding ( bracket, onException ) import GHC.IO.IOMode import GHC.IO.Handle.FD import qualified GHC.IO.FD as FD
System/IO/Error.hs view
@@ -1,4 +1,5 @@-{-# OPTIONS_GHC -XNoImplicitPrelude #-}+{-# LANGUAGE Trustworthy #-}+{-# LANGUAGE CPP, NoImplicitPrelude #-}  ----------------------------------------------------------------------------- -- |@@ -76,7 +77,9 @@      ioError,                    -- :: IOError -> IO a +    catchIOError,               -- :: IO a -> (IOError -> IO a) -> IO a     catch,                      -- :: IO a -> (IOError -> IO a) -> IO a+    tryIOError,                 -- :: IO a -> IO (Either IOError a)     try,                        -- :: IO a -> IO (Either IOError a)      modifyIOError,              -- :: (IOError -> IOError) -> IO a -> IO a@@ -128,13 +131,20 @@ import Control.Monad (MonadPlus(mplus)) #endif --- | The construct 'try' @comp@ exposes IO errors which occur within a+-- | The construct 'tryIOError' @comp@ exposes IO errors which occur within a -- computation, and which are not fully handled. -- -- Non-I\/O exceptions are not caught by this variant; to catch all -- exceptions, use 'Control.Exception.try' from "Control.Exception".+tryIOError     :: IO a -> IO (Either IOError a)+tryIOError f   =  catch (do r <- f+                            return (Right r))+                        (return . Left)  #ifndef __NHC__+{-# DEPRECATED try "Please use the new exceptions variant, Control.Exception.try" #-}+-- | The 'try' function is deprecated. Please use the new exceptions+-- variant, 'Control.Exception.try' from "Control.Exception", instead. try            :: IO a -> IO (Either IOError a) try f          =  catch (do r <- f                             return (Right r))@@ -436,14 +446,16 @@ #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+-- | The 'catchIOError' function establishes a handler that receives any+-- 'IOError' raised in the action protected by 'catchIOError'.+-- An 'IOError' is caught by+-- the most recent handler established by one of the exception handling+-- functions.  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)+-- > f = catchIOError 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@@ -454,6 +466,12 @@ -- -- Non-I\/O exceptions are not caught by this variant; to catch all -- exceptions, use 'Control.Exception.catch' from "Control.Exception".+catchIOError :: IO a -> (IOError -> IO a) -> IO a+catchIOError = New.catch++{-# DEPRECATED catch "Please use the new exceptions variant, Control.Exception.catch" #-}+-- | The 'catch' function is deprecated. Please use the new exceptions+-- variant, 'Control.Exception.catch' from "Control.Exception", instead. catch :: IO a -> (IOError -> IO a) -> IO a catch = New.catch #endif /* !__HUGS__ */
System/IO/Unsafe.hs view
@@ -1,4 +1,5 @@-{-# OPTIONS_GHC -XNoImplicitPrelude #-}+{-# LANGUAGE CPP, NoImplicitPrelude #-}+ ----------------------------------------------------------------------------- -- | -- Module      :  System.IO.Unsafe@@ -16,18 +17,21 @@ module System.IO.Unsafe (    -- * Unsafe 'System.IO.IO' operations    unsafePerformIO,     -- :: IO a -> a+   unsafeDupablePerformIO, -- :: IO a -> a    unsafeInterleaveIO,  -- :: IO a -> IO a   ) where  #ifdef __GLASGOW_HASKELL__-import GHC.IO (unsafePerformIO, unsafeInterleaveIO)+import GHC.IO      (unsafePerformIO, unsafeInterleaveIO, unsafeDupablePerformIO) #endif  #ifdef __HUGS__ import Hugs.IOExts (unsafePerformIO, unsafeInterleaveIO)+unsafeDupablePerformIO = unsafePerformIO #endif  #ifdef __NHC__ import NHC.Internal (unsafePerformIO, unsafeInterleaveIO)+unsafeDupablePerformIO = unsafePerformIO #endif
System/Info.hs view
@@ -1,3 +1,6 @@+{-# LANGUAGE Safe #-}+{-# LANGUAGE CPP #-}+ ----------------------------------------------------------------------------- -- | -- Module      :  System.Info
System/Mem.hs view
@@ -1,3 +1,10 @@+{-# LANGUAGE Safe #-}+{-# LANGUAGE CPP #-}++#ifdef __GLASGOW_HASKELL__+{-# LANGUAGE ForeignFunctionInterface #-}+#endif+ ----------------------------------------------------------------------------- -- | -- Module      :  System.Mem
System/Mem/StableName.hs view
@@ -1,3 +1,13 @@+{-# LANGUAGE Trustworthy #-}+{-# LANGUAGE CPP #-}+#ifdef __GLASGOW_HASKELL__+{-# LANGUAGE DeriveDataTypeable, StandaloneDeriving #-}+{-# LANGUAGE MagicHash #-}+#if !defined(__PARALLEL_HASKELL__)+{-# LANGUAGE UnboxedTuples #-}+#endif+#endif+ ----------------------------------------------------------------------------- -- | -- Module      :  System.Mem.StableName
System/Mem/Weak.hs view
@@ -1,3 +1,6 @@+{-# LANGUAGE Trustworthy #-}+{-# LANGUAGE CPP #-}+ ----------------------------------------------------------------------------- -- | -- Module      :  System.Mem.Weak@@ -67,16 +70,12 @@ 	-- $precise    ) where -import Data.Maybe (Maybe(..))- #ifdef __HUGS__ import Hugs.Weak import Prelude #endif  #ifdef __GLASGOW_HASKELL__-import GHC.Base (return)-import GHC.Types (IO) import GHC.Weak #endif
System/Posix/Internals.hs view
@@ -1,5 +1,5 @@-{-# OPTIONS_GHC -XNoImplicitPrelude #-}-{-# OPTIONS_GHC -fno-warn-unused-binds #-}+{-# LANGUAGE Trustworthy #-}+{-# LANGUAGE CPP, NoImplicitPrelude, ForeignFunctionInterface #-} {-# OPTIONS_HADDOCK hide #-}  -----------------------------------------------------------------------------@@ -52,6 +52,10 @@ import GHC.IO.IOMode import GHC.IO.Exception import GHC.IO.Device+#ifndef mingw32_HOST_OS+import {-# SOURCE #-} GHC.IO.Encoding (fileSystemEncoding)+import qualified GHC.Foreign as GHC+#endif #elif __HUGS__ import Hugs.Prelude (IOException(..), IOErrorType(..)) import Hugs.IO (IOMode(..))@@ -66,7 +70,19 @@ {-# CFILES cbits/PrelIOUtils.c cbits/consUtils.c #-} #endif + -- ---------------------------------------------------------------------------+-- Debugging the base package++puts :: String -> IO ()+puts s = withCAStringLen (s ++ "\n") $ \(p, len) -> do+            -- In reality should be withCString, but assume ASCII to avoid loop+            -- if this is called by GHC.Foreign+           _ <- c_write 1 (castPtr p) (fromIntegral len)+           return ()+++-- --------------------------------------------------------------------------- -- Types  type CFLock     = ()@@ -172,12 +188,28 @@  #ifdef mingw32_HOST_OS withFilePath :: FilePath -> (CWString -> IO a) -> IO a-withFilePath = withCWString +withFilePath = withCWString++peekFilePath :: CWString -> IO FilePath+peekFilePath = peekCWString #else+ withFilePath :: FilePath -> (CString -> IO a) -> IO a+peekFilePath :: CString -> IO FilePath+peekFilePathLen :: CStringLen -> IO FilePath++#if __GLASGOW_HASKELL__+withFilePath = GHC.withCString fileSystemEncoding+peekFilePath = GHC.peekCString fileSystemEncoding+peekFilePathLen = GHC.peekCStringLen fileSystemEncoding+#else withFilePath = withCString+peekFilePath = peekCString+peekFilePathLen = peekCStringLen #endif +#endif+ -- --------------------------------------------------------------------------- -- Terminal-related stuff @@ -395,6 +427,9 @@  foreign import ccall unsafe "HsBase.h __hscore_open"    c_open :: CFilePath -> CInt -> CMode -> IO CInt++foreign import ccall safe "HsBase.h __hscore_open"+   c_safe_open :: CFilePath -> CInt -> CMode -> IO CInt  foreign import ccall unsafe "HsBase.h read"     c_read :: CInt -> Ptr Word8 -> CSize -> IO CSsize
+ System/Posix/Internals.hs-boot view
@@ -0,0 +1,8 @@+{-# LANGUAGE Trustworthy #-}+{-# LANGUAGE NoImplicitPrelude #-}+module System.Posix.Internals where++import GHC.IO+import GHC.Base++puts :: String -> IO ()
System/Posix/Types.hs view
@@ -1,5 +1,13 @@-{-# OPTIONS_GHC -XNoImplicitPrelude #-}-{-# OPTIONS_GHC -fno-warn-unused-binds #-}+{-# LANGUAGE Trustworthy #-}+{-# LANGUAGE CPP+           , NoImplicitPrelude+           , MagicHash+           , GeneralizedNewtypeDeriving+  #-}+#ifdef __GLASGOW_HASKELL__+{-# LANGUAGE DeriveDataTypeable, StandaloneDeriving #-}+#endif+ ----------------------------------------------------------------------------- -- | -- Module      :  System.Posix.Types
System/Timeout.hs view
@@ -1,3 +1,9 @@+{-# LANGUAGE Trustworthy #-}+{-# LANGUAGE CPP #-}+#ifdef __GLASGOW_HASKELL__+{-# LANGUAGE DeriveDataTypeable, StandaloneDeriving #-}+#endif+ ------------------------------------------------------------------------------- -- | -- Module      :  System.Timeout@@ -32,7 +38,7 @@ -- interrupt the running IO computation when the timeout has -- expired. -data Timeout = Timeout Unique deriving Eq+newtype Timeout = Timeout Unique deriving Eq INSTANCE_TYPEABLE0(Timeout,timeoutTc,"Timeout")  instance Show Timeout where
Text/ParserCombinators/ReadP.hs view
@@ -1,4 +1,12 @@-{-# OPTIONS_GHC -XNoImplicitPrelude #-}+{-# LANGUAGE Trustworthy #-}+{-# LANGUAGE CPP, NoImplicitPrelude #-}+#ifndef __NHC__+{-# LANGUAGE Rank2Types #-}+#endif+#ifdef __GLASGOW_HASKELL__+{-# LANGUAGE MagicHash #-}+#endif+ ----------------------------------------------------------------------------- -- | -- Module      :  Text.ParserCombinators.ReadP
Text/ParserCombinators/ReadPrec.hs view
@@ -1,4 +1,6 @@-{-# OPTIONS_GHC -XNoImplicitPrelude #-}+{-# LANGUAGE Trustworthy #-}+{-# LANGUAGE CPP, NoImplicitPrelude #-}+ ----------------------------------------------------------------------------- -- | -- Module      :  Text.ParserCombinators.ReadPrec
Text/Printf.hs view
@@ -1,3 +1,6 @@+{-# LANGUAGE Safe #-}+{-# LANGUAGE CPP #-}+ ----------------------------------------------------------------------------- -- | -- Module      :  Text.Printf
Text/Read.hs view
@@ -1,4 +1,6 @@-{-# OPTIONS_GHC -XNoImplicitPrelude #-}+{-# LANGUAGE Trustworthy #-}+{-# LANGUAGE CPP, NoImplicitPrelude #-}+ ----------------------------------------------------------------------------- -- | -- Module      :  Text.Read
Text/Read/Lex.hs view
@@ -1,4 +1,6 @@-{-# OPTIONS_GHC -XNoImplicitPrelude #-}+{-# LANGUAGE Trustworthy #-}+{-# LANGUAGE CPP, NoImplicitPrelude #-}+ ----------------------------------------------------------------------------- -- | -- Module      :  Text.Read.Lex
Text/Show.hs view
@@ -1,4 +1,6 @@-{-# OPTIONS_GHC -XNoImplicitPrelude #-}+{-# LANGUAGE Safe #-}+{-# LANGUAGE CPP, NoImplicitPrelude #-}+ ----------------------------------------------------------------------------- -- | -- Module      :  Text.Show
Text/Show/Functions.hs view
@@ -1,5 +1,8 @@+{-# LANGUAGE Safe #-}+{-# LANGUAGE CPP #-} -- This module deliberately declares orphan instances: {-# OPTIONS_GHC -fno-warn-orphans #-}+ ----------------------------------------------------------------------------- -- | -- Module      :  Text.Show.Functions
Unsafe/Coerce.hs view
@@ -1,4 +1,5 @@-{-# OPTIONS_GHC -XNoImplicitPrelude #-}+{-# LANGUAGE CPP, NoImplicitPrelude, MagicHash #-}+ ----------------------------------------------------------------------------- -- | -- Module      :  Unsafe.Coerce
aclocal.m4 view
@@ -7,8 +7,10 @@ # Implementation note: We are lazy and use an internal autoconf macro, but it # is supported in autoconf versions 2.50 up to the actual 2.57, so there is # little risk.+# The public AC_COMPUTE_INT macro isn't supported by some versions of+# autoconf. AC_DEFUN([FP_COMPUTE_INT],-[_AC_COMPUTE_INT([$1], [$2], [$3], [$4])[]dnl+[_AC_COMPUTE_INT([$2], [$1], [$3], [$4])[]dnl ])# FP_COMPUTE_INT  @@ -19,7 +21,7 @@ AC_DEFUN([FP_CHECK_CONST], [AS_VAR_PUSHDEF([fp_Cache], [fp_cv_const_$1])[]dnl AC_CACHE_CHECK([value of $1], fp_Cache,-[FP_COMPUTE_INT([$1], fp_check_const_result, [AC_INCLUDES_DEFAULT([$2])],+[FP_COMPUTE_INT(fp_check_const_result, [$1], [AC_INCLUDES_DEFAULT([$2])],                 [fp_check_const_result=m4_default([$3], ['-1'])]) AS_VAR_SET(fp_Cache, [$fp_check_const_result])])[]dnl AC_DEFINE_UNQUOTED(AS_TR_CPP([CONST_$1]), AS_VAR_GET(fp_Cache), [The value of $1.])[]dnl@@ -49,24 +51,10 @@ ])# FP_CHECK_CONSTS  -dnl ** Map an arithmetic C type to a Haskell type.-dnl    Based on autconf's AC_CHECK_SIZEOF.--dnl FPTOOLS_CHECK_HTYPE(TYPE [, DEFAULT_VALUE, [, VALUE-FOR-CROSS-COMPILATION])-AC_DEFUN([FPTOOLS_CHECK_HTYPE],-[changequote(<<, >>)dnl-dnl The name to #define.-define(<<AC_TYPE_NAME>>, translit(htype_$1, [a-z *], [A-Z_P]))dnl-dnl The cache variable name.-define(<<AC_CV_NAME>>, translit(fptools_cv_htype_$1, [ *], [_p]))dnl-define(<<AC_CV_NAME_supported>>, translit(fptools_cv_htype_sup_$1, [ *], [_p]))dnl-changequote([, ])dnl-AC_MSG_CHECKING(Haskell type for $1)-AC_CACHE_VAL(AC_CV_NAME,-[AC_CV_NAME_supported=yes-fp_check_htype_save_cppflags="$CPPFLAGS"-CPPFLAGS="$CPPFLAGS $X_CFLAGS"-AC_RUN_IFELSE([AC_LANG_SOURCE([[#include <stdio.h>+dnl FPTOOLS_HTYPE_INCLUDES+AC_DEFUN([FPTOOLS_HTYPE_INCLUDES],+[+#include <stdio.h> #include <stddef.h>  #if HAVE_SYS_TYPES_H@@ -113,59 +101,97 @@ # endif #endif -#if defined(HAVE_GL_GL_H)-# include <GL/gl.h>-#elif defined(HAVE_OPENGL_GL_H)-# include <OpenGL/gl.h>-#endif--#if defined(HAVE_AL_AL_H)-# include <AL/al.h>-#elif defined(HAVE_OPENAL_AL_H)-# include <OpenAL/al.h>-#endif--#if defined(HAVE_AL_ALC_H)-# include <AL/alc.h>-#elif defined(HAVE_OPENAL_ALC_H)-# include <OpenAL/alc.h>-#endif- #if HAVE_SYS_RESOURCE_H # include <sys/resource.h> #endif  #include <stdlib.h>+]) -typedef $1 testing; -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",-           (int)(sizeof(testing)*8));-  } else {-    fprintf(f,"%s\n",-           (sizeof(testing) >  sizeof(double)) ? "LDouble" :-           (sizeof(testing) == sizeof(double)) ? "Double"  : "Float");-  }-  fclose(f);-  exit(0);-}]])],[AC_CV_NAME=`cat conftestval`],-[ifelse([$2], , [AC_CV_NAME=NotReallyAType; AC_CV_NAME_supported=no], [AC_CV_NAME=$2])],-[ifelse([$3], , [AC_CV_NAME=NotReallyATypeCross; AC_CV_NAME_supported=no], [AC_CV_NAME=$3])])-CPPFLAGS="$fp_check_htype_save_cppflags"]) dnl-if test "$AC_CV_NAME_supported" = yes; then-  AC_MSG_RESULT($AC_CV_NAME)-  AC_DEFINE_UNQUOTED(AC_TYPE_NAME, $AC_CV_NAME, [Define to Haskell type for $1])-else-  AC_MSG_RESULT([not supported])-fi-undefine([AC_TYPE_NAME])dnl-undefine([AC_CV_NAME])dnl-undefine([AC_CV_NAME_supported])dnl+dnl ** Map an arithmetic C type to a Haskell type.+dnl    Based on autconf's AC_CHECK_SIZEOF.++dnl FPTOOLS_CHECK_HTYPE_ELSE(TYPE, WHAT_TO_DO_IF_TYPE_DOES_NOT_EXIST)+AC_DEFUN([FPTOOLS_CHECK_HTYPE_ELSE],[+    changequote(<<, >>)+    dnl The name to #define.+    define(<<AC_TYPE_NAME>>, translit(htype_$1, [a-z *], [A-Z_P]))+    dnl The cache variable names.+    define(<<AC_CV_NAME>>, translit(fptools_cv_htype_$1, [ *], [_p]))+    define(<<AC_CV_NAME_supported>>, translit(fptools_cv_htype_sup_$1, [ *], [_p]))+    changequote([, ])++    AC_MSG_CHECKING(Haskell type for $1)+    AC_CACHE_VAL(AC_CV_NAME,[+        AC_CV_NAME_supported=yes+        FP_COMPUTE_INT([HTYPE_IS_INTEGRAL],+                       [(($1)((int)(($1)1.4))) == (($1)1.4)],+                       [FPTOOLS_HTYPE_INCLUDES],[AC_CV_NAME_supported=no])+        if test "$AC_CV_NAME_supported" = "yes"+        then+            if test "$HTYPE_IS_INTEGRAL" -eq 0+            then+                FP_COMPUTE_INT([HTYPE_IS_FLOAT],[sizeof($1) == sizeof(float)],+                               [FPTOOLS_HTYPE_INCLUDES],+                               [AC_CV_NAME_supported=no])+                FP_COMPUTE_INT([HTYPE_IS_DOUBLE],[sizeof($1) == sizeof(double)],+                               [FPTOOLS_HTYPE_INCLUDES],+                               [AC_CV_NAME_supported=no])+                FP_COMPUTE_INT([HTYPE_IS_LDOUBLE],[sizeof($1) == sizeof(long double)],+                               [FPTOOLS_HTYPE_INCLUDES],+                               [AC_CV_NAME_supported=no])+                if test "$HTYPE_IS_FLOAT" -eq 1+                then+                    AC_CV_NAME=Float+                elif test "$HTYPE_IS_DOUBLE" -eq 1+                then+                    AC_CV_NAME=Double+                elif test "$HTYPE_IS_LDOUBLE" -eq 1+                then+                    AC_CV_NAME=LDouble+                else+                    AC_CV_NAME_supported=no+                fi+            else+                FP_COMPUTE_INT([HTYPE_IS_SIGNED],[(($1)(-1)) < (($1)0)],+                               [FPTOOLS_HTYPE_INCLUDES],+                               [AC_CV_NAME_supported=no])+                FP_COMPUTE_INT([HTYPE_SIZE],[sizeof($1) * 8],+                               [FPTOOLS_HTYPE_INCLUDES],+                               [AC_CV_NAME_supported=no])+                if test "$HTYPE_IS_SIGNED" -eq 0+                then+                    AC_CV_NAME="Word$HTYPE_SIZE"+                else+                    AC_CV_NAME="Int$HTYPE_SIZE"+                fi+            fi+        fi+        ])+    if test "$AC_CV_NAME_supported" = no+    then+        $2+    fi++    dnl Note: evaluating dollar-2 can change the value of+    dnl $AC_CV_NAME_supported, so we might now get a different answer+    if test "$AC_CV_NAME_supported" = yes; then+        AC_MSG_RESULT($AC_CV_NAME)+        AC_DEFINE_UNQUOTED(AC_TYPE_NAME, $AC_CV_NAME,+                           [Define to Haskell type for $1])+    fi+    undefine([AC_TYPE_NAME])dnl+    undefine([AC_CV_NAME])dnl+    undefine([AC_CV_NAME_supported])dnl+])++dnl FPTOOLS_CHECK_HTYPE(TYPE)+AC_DEFUN([FPTOOLS_CHECK_HTYPE],[+    FPTOOLS_CHECK_HTYPE_ELSE([$1],[+        AC_CV_NAME=NotReallyAType+        AC_MSG_RESULT([not supported])+    ]) ])
base.cabal view
@@ -1,5 +1,5 @@ name:           base-version:        4.3.1.0+version:        4.4.0.0 license:        BSD3 license-file:   LICENSE maintainer:     libraries@haskell.org@@ -17,11 +17,11 @@ extra-source-files:                 config.guess config.sub install-sh                 aclocal.m4 configure.ac configure-                include/CTypes.h+                include/CTypes.h include/md5.h  source-repository head-    type:     darcs-    location: http://darcs.haskell.org/packages/base/+    type:     git+    location: http://darcs.haskell.org/packages/base.git/  Flag integer-simple     Description: Use integer-simple@@ -51,35 +51,41 @@             GHC.Err,             GHC.Exception,             GHC.Exts,+            GHC.Fingerprint,+            GHC.Fingerprint.Type,             GHC.Float,+            GHC.Float.ConversionUtils,+            GHC.Float.RealFracMethods,+            GHC.Foreign,             GHC.ForeignPtr,-            GHC.MVar,+            GHC.Handle,             GHC.IO,-            GHC.IO.IOMode,             GHC.IO.Buffer,-            GHC.IO.Device,             GHC.IO.BufferedIO,-            GHC.IO.FD,-            GHC.IO.Exception,+            GHC.IO.Device,             GHC.IO.Encoding,+            GHC.IO.Encoding.CodePage,+            GHC.IO.Encoding.Failure,+            GHC.IO.Encoding.Iconv,             GHC.IO.Encoding.Latin1,-            GHC.IO.Encoding.UTF8,+            GHC.IO.Encoding.Types,             GHC.IO.Encoding.UTF16,             GHC.IO.Encoding.UTF32,-            GHC.IO.Encoding.Types,-            GHC.IO.Encoding.Iconv,-            GHC.IO.Encoding.CodePage,+            GHC.IO.Encoding.UTF8,+            GHC.IO.Exception,+            GHC.IO.FD,             GHC.IO.Handle,-            GHC.IO.Handle.Types,-            GHC.IO.Handle.Internals,             GHC.IO.Handle.FD,+            GHC.IO.Handle.Internals,             GHC.IO.Handle.Text,+            GHC.IO.Handle.Types,+            GHC.IO.IOMode,+            GHC.IOArray,             GHC.IOBase,-            GHC.Handle,             GHC.IORef,-            GHC.IOArray,             GHC.Int,             GHC.List,+            GHC.MVar,             GHC.Num,             GHC.PArr,             GHC.Pack,@@ -87,10 +93,10 @@             GHC.Read,             GHC.Real,             GHC.ST,-            GHC.STRef,             GHC.Show,             GHC.Stable,             GHC.Storable,+            GHC.STRef,             GHC.TopHandler,             GHC.Unicode,             GHC.Weak,@@ -99,16 +105,7 @@         if os(windows)             exposed-modules: GHC.IO.Encoding.CodePage.Table                              GHC.Conc.Windows-        extensions: MagicHash, ExistentialQuantification, Rank2Types,-                    ScopedTypeVariables, UnboxedTuples,-                    ForeignFunctionInterface, UnliftedFFITypes,-                    DeriveDataTypeable, GeneralizedNewtypeDeriving,-                    FlexibleInstances, StandaloneDeriving,-                    PatternGuards, EmptyDataDecls, NoImplicitPrelude--        if impl(ghc < 6.10)-           -- PatternSignatures was deprecated in 6.10-           extensions: PatternSignatures+                             GHC.Windows     }     exposed-modules:         Control.Applicative,@@ -126,9 +123,15 @@         Control.Monad,         Control.Monad.Fix,         Control.Monad.Instances,-        Control.Monad.ST-        Control.Monad.ST.Lazy-        Control.Monad.ST.Strict+        Control.Monad.ST,+        Control.Monad.ST.Safe,+        Control.Monad.ST.Unsafe,+        Control.Monad.ST.Lazy,+        Control.Monad.ST.Lazy.Safe,+        Control.Monad.ST.Lazy.Unsafe,+        Control.Monad.ST.Strict,+        Control.Monad.Group+        Control.Monad.Zip         Data.Bits,         Data.Bool,         Data.Char,@@ -157,6 +160,7 @@         Data.Traversable         Data.Tuple,         Data.Typeable,+        Data.Typeable.Internal,         Data.Unique,         Data.Version,         Data.Word,@@ -167,13 +171,18 @@         Foreign.C.String,         Foreign.C.Types,         Foreign.ForeignPtr,+        Foreign.ForeignPtr.Safe,+        Foreign.ForeignPtr.Unsafe,         Foreign.Marshal,         Foreign.Marshal.Alloc,         Foreign.Marshal.Array,         Foreign.Marshal.Error,         Foreign.Marshal.Pool,+        Foreign.Marshal.Safe,         Foreign.Marshal.Utils,+        Foreign.Marshal.Unsafe,         Foreign.Ptr,+        Foreign.Safe,         Foreign.StablePtr,         Foreign.Storable,         Numeric,@@ -199,6 +208,10 @@         Text.Show,         Text.Show.Functions         Unsafe.Coerce+    other-modules:+        Control.Monad.ST.Imp+        Control.Monad.ST.Lazy.Imp+        Foreign.ForeignPtr.Imp     c-sources:         cbits/PrelIOUtils.c         cbits/WCsubst.c@@ -208,6 +221,7 @@         cbits/inputReady.c         cbits/selectUtils.c         cbits/primFloat.c+        cbits/md5.c     include-dirs: include     includes:    HsBase.h     install-includes:    HsBase.h HsBaseConfig.h EventConfig.h WCsubst.h consUtils.h Typeable.h@@ -216,24 +230,24 @@     }     if !os(windows) {         exposed-modules:-            System.Event+            GHC.Event         other-modules:-            System.Event.Array-            System.Event.Clock-            System.Event.Control-            System.Event.EPoll-            System.Event.IntMap-            System.Event.Internal-            System.Event.KQueue-            System.Event.Manager-            System.Event.PSQ-            System.Event.Poll-            System.Event.Thread-            System.Event.Unique+            GHC.Event.Array+            GHC.Event.Clock+            GHC.Event.Control+            GHC.Event.EPoll+            GHC.Event.IntMap+            GHC.Event.Internal+            GHC.Event.KQueue+            GHC.Event.Manager+            GHC.Event.PSQ+            GHC.Event.Poll+            GHC.Event.Thread+            GHC.Event.Unique     }-    extensions: CPP     -- We need to set the package name to base (without a version number)     -- as it's magic.     ghc-options: -package-name base     nhc98-options: -H4M -K3M+    extensions: CPP }
cbits/WCsubst.c view
@@ -1,4027 +1,4282 @@ /*------------------------------------------------------------------------- This is an automatically generated file: do not edit-Generated by ubconfc at Fri Jun 13 20:47:01 BST 2008--------------------------------------------------------------------------*/--#include "WCsubst.h"--/* Unicode general categories, listed in the same order as in the Unicode- * standard -- this must be the same order as in GHC.Unicode.- */--enum {-    NUMCAT_LU,  /* Letter, Uppercase */-    NUMCAT_LL,  /* Letter, Lowercase */-    NUMCAT_LT,  /* Letter, Titlecase */-    NUMCAT_LM,  /* Letter, Modifier */-    NUMCAT_LO,  /* Letter, Other */-    NUMCAT_MN,  /* Mark, Non-Spacing */-    NUMCAT_MC,  /* Mark, Spacing Combining */-    NUMCAT_ME,  /* Mark, Enclosing */-    NUMCAT_ND,  /* Number, Decimal */-    NUMCAT_NL,  /* Number, Letter */-    NUMCAT_NO,  /* Number, Other */-    NUMCAT_PC,  /* Punctuation, Connector */-    NUMCAT_PD,  /* Punctuation, Dash */-    NUMCAT_PS,  /* Punctuation, Open */-    NUMCAT_PE,  /* Punctuation, Close */-    NUMCAT_PI,  /* Punctuation, Initial quote */-    NUMCAT_PF,  /* Punctuation, Final quote */-    NUMCAT_PO,  /* Punctuation, Other */-    NUMCAT_SM,  /* Symbol, Math */-    NUMCAT_SC,  /* Symbol, Currency */-    NUMCAT_SK,  /* Symbol, Modifier */-    NUMCAT_SO,  /* Symbol, Other */-    NUMCAT_ZS,  /* Separator, Space */-    NUMCAT_ZL,  /* Separator, Line */-    NUMCAT_ZP,  /* Separator, Paragraph */-    NUMCAT_CC,  /* Other, Control */-    NUMCAT_CF,  /* Other, Format */-    NUMCAT_CS,  /* Other, Surrogate */-    NUMCAT_CO,  /* Other, Private Use */-    NUMCAT_CN   /* Other, Not Assigned */-};--struct _convrule_ -{ -	unsigned int category;-	unsigned int catnumber;-	int possible;-	int updist;-	int lowdist; -	int titledist;-};--struct _charblock_ -{ -	int start;-	int length;-	const struct _convrule_ *rule;-};--#define GENCAT_LO 262144-#define GENCAT_PC 2048-#define GENCAT_PD 128-#define GENCAT_MN 2097152-#define GENCAT_PE 32-#define GENCAT_NL 16777216-#define GENCAT_PF 131072-#define GENCAT_LT 524288-#define GENCAT_LU 512-#define GENCAT_NO 65536-#define GENCAT_PI 16384-#define GENCAT_SC 8-#define GENCAT_PO 4-#define GENCAT_PS 16-#define GENCAT_SK 1024-#define GENCAT_SM 64-#define GENCAT_SO 8192-#define GENCAT_CC 1-#define GENCAT_CF 32768-#define GENCAT_CO 268435456-#define GENCAT_ZL 33554432-#define GENCAT_CS 134217728-#define GENCAT_ZP 67108864-#define GENCAT_ZS 2-#define GENCAT_MC 8388608-#define GENCAT_ME 4194304-#define GENCAT_ND 256-#define GENCAT_LL 4096-#define GENCAT_LM 1048576-#define MAX_UNI_CHAR 1114109-#define NUM_BLOCKS 2562-#define NUM_CONVBLOCKS 1202-#define NUM_SPACEBLOCKS 8-#define NUM_LAT1BLOCKS 63-#define NUM_RULES 161-static const struct _convrule_ rule155={GENCAT_LL, NUMCAT_LL, 1, -7264, 0, -7264};-static const struct _convrule_ rule36={GENCAT_LU, NUMCAT_LU, 1, 0, 211, 0};-static const struct _convrule_ rule25={GENCAT_LU, NUMCAT_LU, 1, 0, -121, 0};-static const struct _convrule_ rule18={GENCAT_LL, NUMCAT_LL, 1, 743, 0, 743};-static const struct _convrule_ rule105={GENCAT_LU, NUMCAT_LU, 1, 0, 80, 0};-static const struct _convrule_ rule50={GENCAT_LL, NUMCAT_LL, 1, -79, 0, -79};-static const struct _convrule_ rule103={GENCAT_LL, NUMCAT_LL, 1, -96, 0, -96};-static const struct _convrule_ rule76={GENCAT_LL, NUMCAT_LL, 1, -69, 0, -69};-static const struct _convrule_ rule123={GENCAT_LL, NUMCAT_LL, 1, 128, 0, 128};-static const struct _convrule_ rule116={GENCAT_LL, NUMCAT_LL, 1, -59, 0, -59};-static const struct _convrule_ rule99={GENCAT_LL, NUMCAT_LL, 1, -86, 0, -86};-static const struct _convrule_ rule38={GENCAT_LL, NUMCAT_LL, 1, 163, 0, 163};-static const struct _convrule_ rule110={GENCAT_LL, NUMCAT_LL, 1, -48, 0, -48};-static const struct _convrule_ rule130={GENCAT_LL, NUMCAT_LL, 1, -7205, 0, -7205};-static const struct _convrule_ rule125={GENCAT_LL, NUMCAT_LL, 1, 126, 0, 126};-static const struct _convrule_ rule94={GENCAT_LL, NUMCAT_LL, 1, -57, 0, -57};-static const struct _convrule_ rule156={GENCAT_LU, NUMCAT_LU, 1, 0, -35332, 0};-static const struct _convrule_ rule133={GENCAT_LU, NUMCAT_LU, 1, 0, -112, 0};-static const struct _convrule_ rule96={GENCAT_LL, NUMCAT_LL, 1, -47, 0, -47};-static const struct _convrule_ rule87={GENCAT_LL, NUMCAT_LL, 1, -38, 0, -38};-static const struct _convrule_ rule32={GENCAT_LU, NUMCAT_LU, 1, 0, 202, 0};-static const struct _convrule_ rule142={GENCAT_LL, NUMCAT_LL, 1, -28, 0, -28};-static const struct _convrule_ rule90={GENCAT_LL, NUMCAT_LL, 1, -64, 0, -64};-static const struct _convrule_ rule88={GENCAT_LL, NUMCAT_LL, 1, -37, 0, -37};-static const struct _convrule_ rule59={GENCAT_LU, NUMCAT_LU, 1, 0, 71, 0};-static const struct _convrule_ rule97={GENCAT_LL, NUMCAT_LL, 1, -54, 0, -54};-static const struct _convrule_ rule91={GENCAT_LL, NUMCAT_LL, 1, -63, 0, -63};-static const struct _convrule_ rule35={GENCAT_LL, NUMCAT_LL, 1, 97, 0, 97};-static const struct _convrule_ rule146={GENCAT_SO, NUMCAT_SO, 1, -26, 0, -26};-static const struct _convrule_ rule100={GENCAT_LL, NUMCAT_LL, 1, -80, 0, -80};-static const struct _convrule_ rule93={GENCAT_LL, NUMCAT_LL, 1, -62, 0, -62};-static const struct _convrule_ rule78={GENCAT_LL, NUMCAT_LL, 1, -71, 0, -71};-static const struct _convrule_ rule9={GENCAT_LU, NUMCAT_LU, 1, 0, 32, 0};-static const struct _convrule_ rule144={GENCAT_NL, NUMCAT_NL, 1, -16, 0, -16};-static const struct _convrule_ rule140={GENCAT_LU, NUMCAT_LU, 1, 0, -8262, 0};-static const struct _convrule_ rule124={GENCAT_LL, NUMCAT_LL, 1, 112, 0, 112};-static const struct _convrule_ rule121={GENCAT_LL, NUMCAT_LL, 1, 86, 0, 86};-static const struct _convrule_ rule40={GENCAT_LL, NUMCAT_LL, 1, 130, 0, 130};-static const struct _convrule_ rule20={GENCAT_LL, NUMCAT_LL, 1, 121, 0, 121};-static const struct _convrule_ rule108={GENCAT_LL, NUMCAT_LL, 1, -15, 0, -15};-static const struct _convrule_ rule12={GENCAT_LL, NUMCAT_LL, 1, -32, 0, -32};-static const struct _convrule_ rule82={GENCAT_MN, NUMCAT_MN, 1, 84, 0, 84};-static const struct _convrule_ rule160={GENCAT_LL, NUMCAT_LL, 1, -40, 0, -40};-static const struct _convrule_ rule122={GENCAT_LL, NUMCAT_LL, 1, 100, 0, 100};-static const struct _convrule_ rule120={GENCAT_LL, NUMCAT_LL, 1, 74, 0, 74};-static const struct _convrule_ rule89={GENCAT_LL, NUMCAT_LL, 1, -31, 0, -31};-static const struct _convrule_ rule56={GENCAT_LU, NUMCAT_LU, 1, 0, 10792, 0};-static const struct _convrule_ rule46={GENCAT_LL, NUMCAT_LL, 1, 56, 0, 56};-static const struct _convrule_ rule33={GENCAT_LU, NUMCAT_LU, 1, 0, 203, 0};-static const struct _convrule_ rule147={GENCAT_LU, NUMCAT_LU, 1, 0, -10743, 0};-static const struct _convrule_ rule39={GENCAT_LU, NUMCAT_LU, 1, 0, 213, 0};-static const struct _convrule_ rule154={GENCAT_LU, NUMCAT_LU, 1, 0, -10783, 0};-static const struct _convrule_ rule55={GENCAT_LU, NUMCAT_LU, 1, 0, -163, 0};-static const struct _convrule_ rule148={GENCAT_LU, NUMCAT_LU, 1, 0, -3814, 0};-static const struct _convrule_ rule139={GENCAT_LU, NUMCAT_LU, 1, 0, -8383, 0};-static const struct _convrule_ rule98={GENCAT_LL, NUMCAT_LL, 1, -8, 0, -8};-static const struct _convrule_ rule86={GENCAT_LU, NUMCAT_LU, 1, 0, 63, 0};-static const struct _convrule_ rule41={GENCAT_LU, NUMCAT_LU, 1, 0, 214, 0};-static const struct _convrule_ rule115={GENCAT_LL, NUMCAT_LL, 1, 3814, 0, 3814};-static const struct _convrule_ rule26={GENCAT_LL, NUMCAT_LL, 1, -300, 0, -300};-static const struct _convrule_ rule112={GENCAT_LU, NUMCAT_LU, 1, 0, 7264, 0};-static const struct _convrule_ rule22={GENCAT_LL, NUMCAT_LL, 1, -1, 0, -1};-static const struct _convrule_ rule117={GENCAT_LU, NUMCAT_LU, 1, 0, -7615, 0};-static const struct _convrule_ rule49={GENCAT_LL, NUMCAT_LL, 1, -2, 0, -1};-static const struct _convrule_ rule128={GENCAT_LU, NUMCAT_LU, 1, 0, -74, 0};-static const struct _convrule_ rule85={GENCAT_LU, NUMCAT_LU, 1, 0, 64, 0};-static const struct _convrule_ rule30={GENCAT_LU, NUMCAT_LU, 1, 0, 205, 0};-static const struct _convrule_ rule114={GENCAT_LL, NUMCAT_LL, 1, 35332, 0, 35332};-static const struct _convrule_ rule107={GENCAT_LU, NUMCAT_LU, 1, 0, 15, 0};-static const struct _convrule_ rule127={GENCAT_LL, NUMCAT_LL, 1, 9, 0, 9};-static const struct _convrule_ rule118={GENCAT_LL, NUMCAT_LL, 1, 8, 0, 8};-static const struct _convrule_ rule92={GENCAT_LU, NUMCAT_LU, 1, 0, 8, 0};-static const struct _convrule_ rule54={GENCAT_LU, NUMCAT_LU, 1, 0, 10795, 0};-static const struct _convrule_ rule29={GENCAT_LU, NUMCAT_LU, 1, 0, 206, 0};-static const struct _convrule_ rule135={GENCAT_LU, NUMCAT_LU, 1, 0, -126, 0};-static const struct _convrule_ rule101={GENCAT_LL, NUMCAT_LL, 1, 7, 0, 7};-static const struct _convrule_ rule57={GENCAT_LU, NUMCAT_LU, 1, 0, -195, 0};-static const struct _convrule_ rule143={GENCAT_NL, NUMCAT_NL, 1, 0, 16, 0};-static const struct _convrule_ rule145={GENCAT_SO, NUMCAT_SO, 1, 0, 26, 0};-static const struct _convrule_ rule104={GENCAT_LU, NUMCAT_LU, 1, 0, -7, 0};-static const struct _convrule_ rule52={GENCAT_LU, NUMCAT_LU, 1, 0, -56, 0};-static const struct _convrule_ rule150={GENCAT_LL, NUMCAT_LL, 1, -10795, 0, -10795};-static const struct _convrule_ rule149={GENCAT_LU, NUMCAT_LU, 1, 0, -10727, 0};-static const struct _convrule_ rule138={GENCAT_LU, NUMCAT_LU, 1, 0, -7517, 0};-static const struct _convrule_ rule34={GENCAT_LU, NUMCAT_LU, 1, 0, 207, 0};-static const struct _convrule_ rule158={GENCAT_CO, NUMCAT_CO, 0, 0, 0, 0};-static const struct _convrule_ rule81={GENCAT_MN, NUMCAT_MN, 0, 0, 0, 0};-static const struct _convrule_ rule16={GENCAT_CF, NUMCAT_CF, 0, 0, 0, 0};-static const struct _convrule_ rule45={GENCAT_LO, NUMCAT_LO, 0, 0, 0, 0};-static const struct _convrule_ rule13={GENCAT_SO, NUMCAT_SO, 0, 0, 0, 0};-static const struct _convrule_ rule8={GENCAT_ND, NUMCAT_ND, 0, 0, 0, 0};-static const struct _convrule_ rule14={GENCAT_LL, NUMCAT_LL, 0, 0, 0, 0};-static const struct _convrule_ rule95={GENCAT_LU, NUMCAT_LU, 0, 0, 0, 0};-static const struct _convrule_ rule6={GENCAT_SM, NUMCAT_SM, 0, 0, 0, 0};-static const struct _convrule_ rule17={GENCAT_NO, NUMCAT_NO, 0, 0, 0, 0};-static const struct _convrule_ rule111={GENCAT_MC, NUMCAT_MC, 0, 0, 0, 0};-static const struct _convrule_ rule2={GENCAT_PO, NUMCAT_PO, 0, 0, 0, 0};-static const struct _convrule_ rule113={GENCAT_NL, NUMCAT_NL, 0, 0, 0, 0};-static const struct _convrule_ rule3={GENCAT_SC, NUMCAT_SC, 0, 0, 0, 0};-static const struct _convrule_ rule10={GENCAT_SK, NUMCAT_SK, 0, 0, 0, 0};-static const struct _convrule_ rule80={GENCAT_LM, NUMCAT_LM, 0, 0, 0, 0};-static const struct _convrule_ rule5={GENCAT_PE, NUMCAT_PE, 0, 0, 0, 0};-static const struct _convrule_ rule4={GENCAT_PS, NUMCAT_PS, 0, 0, 0, 0};-static const struct _convrule_ rule11={GENCAT_PC, NUMCAT_PC, 0, 0, 0, 0};-static const struct _convrule_ rule7={GENCAT_PD, NUMCAT_PD, 0, 0, 0, 0};-static const struct _convrule_ rule157={GENCAT_CS, NUMCAT_CS, 0, 0, 0, 0};-static const struct _convrule_ rule106={GENCAT_ME, NUMCAT_ME, 0, 0, 0, 0};-static const struct _convrule_ rule1={GENCAT_ZS, NUMCAT_ZS, 0, 0, 0, 0};-static const struct _convrule_ rule19={GENCAT_PF, NUMCAT_PF, 0, 0, 0, 0};-static const struct _convrule_ rule15={GENCAT_PI, NUMCAT_PI, 0, 0, 0, 0};-static const struct _convrule_ rule137={GENCAT_ZP, NUMCAT_ZP, 0, 0, 0, 0};-static const struct _convrule_ rule136={GENCAT_ZL, NUMCAT_ZL, 0, 0, 0, 0};-static const struct _convrule_ rule131={GENCAT_LU, NUMCAT_LU, 1, 0, -86, 0};-static const struct _convrule_ rule43={GENCAT_LU, NUMCAT_LU, 1, 0, 217, 0};-static const struct _convrule_ rule0={GENCAT_CC, NUMCAT_CC, 0, 0, 0, 0};-static const struct _convrule_ rule151={GENCAT_LL, NUMCAT_LL, 1, -10792, 0, -10792};-static const struct _convrule_ rule71={GENCAT_LL, NUMCAT_LL, 1, 10749, 0, 10749};-static const struct _convrule_ rule84={GENCAT_LU, NUMCAT_LU, 1, 0, 37, 0};-static const struct _convrule_ rule60={GENCAT_LL, NUMCAT_LL, 1, 10783, 0, 10783};-static const struct _convrule_ rule119={GENCAT_LU, NUMCAT_LU, 1, 0, -8, 0};-static const struct _convrule_ rule126={GENCAT_LT, NUMCAT_LT, 1, 0, -8, 0};-static const struct _convrule_ rule79={GENCAT_LL, NUMCAT_LL, 1, -219, 0, -219};-static const struct _convrule_ rule74={GENCAT_LL, NUMCAT_LL, 1, 10727, 0, 10727};-static const struct _convrule_ rule75={GENCAT_LL, NUMCAT_LL, 1, -218, 0, -218};-static const struct _convrule_ rule68={GENCAT_LL, NUMCAT_LL, 1, -209, 0, -209};-static const struct _convrule_ rule61={GENCAT_LL, NUMCAT_LL, 1, 10780, 0, 10780};-static const struct _convrule_ rule48={GENCAT_LT, NUMCAT_LT, 1, -1, 1, 0};-static const struct _convrule_ rule21={GENCAT_LU, NUMCAT_LU, 1, 0, 1, 0};-static const struct _convrule_ rule134={GENCAT_LU, NUMCAT_LU, 1, 0, -128, 0};-static const struct _convrule_ rule77={GENCAT_LL, NUMCAT_LL, 1, -217, 0, -217};-static const struct _convrule_ rule70={GENCAT_LL, NUMCAT_LL, 1, 10743, 0, 10743};-static const struct _convrule_ rule42={GENCAT_LU, NUMCAT_LU, 1, 0, 218, 0};-static const struct _convrule_ rule67={GENCAT_LL, NUMCAT_LL, 1, -207, 0, -207};-static const struct _convrule_ rule51={GENCAT_LU, NUMCAT_LU, 1, 0, -97, 0};-static const struct _convrule_ rule141={GENCAT_LU, NUMCAT_LU, 1, 0, 28, 0};-static const struct _convrule_ rule63={GENCAT_LL, NUMCAT_LL, 1, -206, 0, -206};-static const struct _convrule_ rule83={GENCAT_LU, NUMCAT_LU, 1, 0, 38, 0};-static const struct _convrule_ rule73={GENCAT_LL, NUMCAT_LL, 1, -214, 0, -214};-static const struct _convrule_ rule64={GENCAT_LL, NUMCAT_LL, 1, -205, 0, -205};-static const struct _convrule_ rule24={GENCAT_LL, NUMCAT_LL, 1, -232, 0, -232};-static const struct _convrule_ rule109={GENCAT_LU, NUMCAT_LU, 1, 0, 48, 0};-static const struct _convrule_ rule129={GENCAT_LT, NUMCAT_LT, 1, 0, -9, 0};-static const struct _convrule_ rule72={GENCAT_LL, NUMCAT_LL, 1, -213, 0, -213};-static const struct _convrule_ rule66={GENCAT_LL, NUMCAT_LL, 1, -203, 0, -203};-static const struct _convrule_ rule132={GENCAT_LU, NUMCAT_LU, 1, 0, -100, 0};-static const struct _convrule_ rule69={GENCAT_LL, NUMCAT_LL, 1, -211, 0, -211};-static const struct _convrule_ rule65={GENCAT_LL, NUMCAT_LL, 1, -202, 0, -202};-static const struct _convrule_ rule47={GENCAT_LU, NUMCAT_LU, 1, 0, 2, 1};-static const struct _convrule_ rule37={GENCAT_LU, NUMCAT_LU, 1, 0, 209, 0};-static const struct _convrule_ rule153={GENCAT_LU, NUMCAT_LU, 1, 0, -10749, 0};-static const struct _convrule_ rule62={GENCAT_LL, NUMCAT_LL, 1, -210, 0, -210};-static const struct _convrule_ rule44={GENCAT_LU, NUMCAT_LU, 1, 0, 219, 0};-static const struct _convrule_ rule28={GENCAT_LU, NUMCAT_LU, 1, 0, 210, 0};-static const struct _convrule_ rule53={GENCAT_LU, NUMCAT_LU, 1, 0, -130, 0};-static const struct _convrule_ rule159={GENCAT_LU, NUMCAT_LU, 1, 0, 40, 0};-static const struct _convrule_ rule152={GENCAT_LU, NUMCAT_LU, 1, 0, -10780, 0};-static const struct _convrule_ rule102={GENCAT_LU, NUMCAT_LU, 1, 0, -60, 0};-static const struct _convrule_ rule58={GENCAT_LU, NUMCAT_LU, 1, 0, 69, 0};-static const struct _convrule_ rule31={GENCAT_LU, NUMCAT_LU, 1, 0, 79, 0};-static const struct _convrule_ rule27={GENCAT_LL, NUMCAT_LL, 1, 195, 0, 195};-static const struct _convrule_ rule23={GENCAT_LU, NUMCAT_LU, 1, 0, -199, 0};-static const struct _charblock_ allchars[]={-	{0, 32, &rule0},-	{32, 1, &rule1},-	{33, 3, &rule2},-	{36, 1, &rule3},-	{37, 3, &rule2},-	{40, 1, &rule4},-	{41, 1, &rule5},-	{42, 1, &rule2},-	{43, 1, &rule6},-	{44, 1, &rule2},-	{45, 1, &rule7},-	{46, 2, &rule2},-	{48, 10, &rule8},-	{58, 2, &rule2},-	{60, 3, &rule6},-	{63, 2, &rule2},-	{65, 26, &rule9},-	{91, 1, &rule4},-	{92, 1, &rule2},-	{93, 1, &rule5},-	{94, 1, &rule10},-	{95, 1, &rule11},-	{96, 1, &rule10},-	{97, 26, &rule12},-	{123, 1, &rule4},-	{124, 1, &rule6},-	{125, 1, &rule5},-	{126, 1, &rule6},-	{127, 33, &rule0},-	{160, 1, &rule1},-	{161, 1, &rule2},-	{162, 4, &rule3},-	{166, 2, &rule13},-	{168, 1, &rule10},-	{169, 1, &rule13},-	{170, 1, &rule14},-	{171, 1, &rule15},-	{172, 1, &rule6},-	{173, 1, &rule16},-	{174, 1, &rule13},-	{175, 1, &rule10},-	{176, 1, &rule13},-	{177, 1, &rule6},-	{178, 2, &rule17},-	{180, 1, &rule10},-	{181, 1, &rule18},-	{182, 1, &rule13},-	{183, 1, &rule2},-	{184, 1, &rule10},-	{185, 1, &rule17},-	{186, 1, &rule14},-	{187, 1, &rule19},-	{188, 3, &rule17},-	{191, 1, &rule2},-	{192, 23, &rule9},-	{215, 1, &rule6},-	{216, 7, &rule9},-	{223, 1, &rule14},-	{224, 23, &rule12},-	{247, 1, &rule6},-	{248, 7, &rule12},-	{255, 1, &rule20},-	{256, 1, &rule21},-	{257, 1, &rule22},-	{258, 1, &rule21},-	{259, 1, &rule22},-	{260, 1, &rule21},-	{261, 1, &rule22},-	{262, 1, &rule21},-	{263, 1, &rule22},-	{264, 1, &rule21},-	{265, 1, &rule22},-	{266, 1, &rule21},-	{267, 1, &rule22},-	{268, 1, &rule21},-	{269, 1, &rule22},-	{270, 1, &rule21},-	{271, 1, &rule22},-	{272, 1, &rule21},-	{273, 1, &rule22},-	{274, 1, &rule21},-	{275, 1, &rule22},-	{276, 1, &rule21},-	{277, 1, &rule22},-	{278, 1, &rule21},-	{279, 1, &rule22},-	{280, 1, &rule21},-	{281, 1, &rule22},-	{282, 1, &rule21},-	{283, 1, &rule22},-	{284, 1, &rule21},-	{285, 1, &rule22},-	{286, 1, &rule21},-	{287, 1, &rule22},-	{288, 1, &rule21},-	{289, 1, &rule22},-	{290, 1, &rule21},-	{291, 1, &rule22},-	{292, 1, &rule21},-	{293, 1, &rule22},-	{294, 1, &rule21},-	{295, 1, &rule22},-	{296, 1, &rule21},-	{297, 1, &rule22},-	{298, 1, &rule21},-	{299, 1, &rule22},-	{300, 1, &rule21},-	{301, 1, &rule22},-	{302, 1, &rule21},-	{303, 1, &rule22},-	{304, 1, &rule23},-	{305, 1, &rule24},-	{306, 1, &rule21},-	{307, 1, &rule22},-	{308, 1, &rule21},-	{309, 1, &rule22},-	{310, 1, &rule21},-	{311, 1, &rule22},-	{312, 1, &rule14},-	{313, 1, &rule21},-	{314, 1, &rule22},-	{315, 1, &rule21},-	{316, 1, &rule22},-	{317, 1, &rule21},-	{318, 1, &rule22},-	{319, 1, &rule21},-	{320, 1, &rule22},-	{321, 1, &rule21},-	{322, 1, &rule22},-	{323, 1, &rule21},-	{324, 1, &rule22},-	{325, 1, &rule21},-	{326, 1, &rule22},-	{327, 1, &rule21},-	{328, 1, &rule22},-	{329, 1, &rule14},-	{330, 1, &rule21},-	{331, 1, &rule22},-	{332, 1, &rule21},-	{333, 1, &rule22},-	{334, 1, &rule21},-	{335, 1, &rule22},-	{336, 1, &rule21},-	{337, 1, &rule22},-	{338, 1, &rule21},-	{339, 1, &rule22},-	{340, 1, &rule21},-	{341, 1, &rule22},-	{342, 1, &rule21},-	{343, 1, &rule22},-	{344, 1, &rule21},-	{345, 1, &rule22},-	{346, 1, &rule21},-	{347, 1, &rule22},-	{348, 1, &rule21},-	{349, 1, &rule22},-	{350, 1, &rule21},-	{351, 1, &rule22},-	{352, 1, &rule21},-	{353, 1, &rule22},-	{354, 1, &rule21},-	{355, 1, &rule22},-	{356, 1, &rule21},-	{357, 1, &rule22},-	{358, 1, &rule21},-	{359, 1, &rule22},-	{360, 1, &rule21},-	{361, 1, &rule22},-	{362, 1, &rule21},-	{363, 1, &rule22},-	{364, 1, &rule21},-	{365, 1, &rule22},-	{366, 1, &rule21},-	{367, 1, &rule22},-	{368, 1, &rule21},-	{369, 1, &rule22},-	{370, 1, &rule21},-	{371, 1, &rule22},-	{372, 1, &rule21},-	{373, 1, &rule22},-	{374, 1, &rule21},-	{375, 1, &rule22},-	{376, 1, &rule25},-	{377, 1, &rule21},-	{378, 1, &rule22},-	{379, 1, &rule21},-	{380, 1, &rule22},-	{381, 1, &rule21},-	{382, 1, &rule22},-	{383, 1, &rule26},-	{384, 1, &rule27},-	{385, 1, &rule28},-	{386, 1, &rule21},-	{387, 1, &rule22},-	{388, 1, &rule21},-	{389, 1, &rule22},-	{390, 1, &rule29},-	{391, 1, &rule21},-	{392, 1, &rule22},-	{393, 2, &rule30},-	{395, 1, &rule21},-	{396, 1, &rule22},-	{397, 1, &rule14},-	{398, 1, &rule31},-	{399, 1, &rule32},-	{400, 1, &rule33},-	{401, 1, &rule21},-	{402, 1, &rule22},-	{403, 1, &rule30},-	{404, 1, &rule34},-	{405, 1, &rule35},-	{406, 1, &rule36},-	{407, 1, &rule37},-	{408, 1, &rule21},-	{409, 1, &rule22},-	{410, 1, &rule38},-	{411, 1, &rule14},-	{412, 1, &rule36},-	{413, 1, &rule39},-	{414, 1, &rule40},-	{415, 1, &rule41},-	{416, 1, &rule21},-	{417, 1, &rule22},-	{418, 1, &rule21},-	{419, 1, &rule22},-	{420, 1, &rule21},-	{421, 1, &rule22},-	{422, 1, &rule42},-	{423, 1, &rule21},-	{424, 1, &rule22},-	{425, 1, &rule42},-	{426, 2, &rule14},-	{428, 1, &rule21},-	{429, 1, &rule22},-	{430, 1, &rule42},-	{431, 1, &rule21},-	{432, 1, &rule22},-	{433, 2, &rule43},-	{435, 1, &rule21},-	{436, 1, &rule22},-	{437, 1, &rule21},-	{438, 1, &rule22},-	{439, 1, &rule44},-	{440, 1, &rule21},-	{441, 1, &rule22},-	{442, 1, &rule14},-	{443, 1, &rule45},-	{444, 1, &rule21},-	{445, 1, &rule22},-	{446, 1, &rule14},-	{447, 1, &rule46},-	{448, 4, &rule45},-	{452, 1, &rule47},-	{453, 1, &rule48},-	{454, 1, &rule49},-	{455, 1, &rule47},-	{456, 1, &rule48},-	{457, 1, &rule49},-	{458, 1, &rule47},-	{459, 1, &rule48},-	{460, 1, &rule49},-	{461, 1, &rule21},-	{462, 1, &rule22},-	{463, 1, &rule21},-	{464, 1, &rule22},-	{465, 1, &rule21},-	{466, 1, &rule22},-	{467, 1, &rule21},-	{468, 1, &rule22},-	{469, 1, &rule21},-	{470, 1, &rule22},-	{471, 1, &rule21},-	{472, 1, &rule22},-	{473, 1, &rule21},-	{474, 1, &rule22},-	{475, 1, &rule21},-	{476, 1, &rule22},-	{477, 1, &rule50},-	{478, 1, &rule21},-	{479, 1, &rule22},-	{480, 1, &rule21},-	{481, 1, &rule22},-	{482, 1, &rule21},-	{483, 1, &rule22},-	{484, 1, &rule21},-	{485, 1, &rule22},-	{486, 1, &rule21},-	{487, 1, &rule22},-	{488, 1, &rule21},-	{489, 1, &rule22},-	{490, 1, &rule21},-	{491, 1, &rule22},-	{492, 1, &rule21},-	{493, 1, &rule22},-	{494, 1, &rule21},-	{495, 1, &rule22},-	{496, 1, &rule14},-	{497, 1, &rule47},-	{498, 1, &rule48},-	{499, 1, &rule49},-	{500, 1, &rule21},-	{501, 1, &rule22},-	{502, 1, &rule51},-	{503, 1, &rule52},-	{504, 1, &rule21},-	{505, 1, &rule22},-	{506, 1, &rule21},-	{507, 1, &rule22},-	{508, 1, &rule21},-	{509, 1, &rule22},-	{510, 1, &rule21},-	{511, 1, &rule22},-	{512, 1, &rule21},-	{513, 1, &rule22},-	{514, 1, &rule21},-	{515, 1, &rule22},-	{516, 1, &rule21},-	{517, 1, &rule22},-	{518, 1, &rule21},-	{519, 1, &rule22},-	{520, 1, &rule21},-	{521, 1, &rule22},-	{522, 1, &rule21},-	{523, 1, &rule22},-	{524, 1, &rule21},-	{525, 1, &rule22},-	{526, 1, &rule21},-	{527, 1, &rule22},-	{528, 1, &rule21},-	{529, 1, &rule22},-	{530, 1, &rule21},-	{531, 1, &rule22},-	{532, 1, &rule21},-	{533, 1, &rule22},-	{534, 1, &rule21},-	{535, 1, &rule22},-	{536, 1, &rule21},-	{537, 1, &rule22},-	{538, 1, &rule21},-	{539, 1, &rule22},-	{540, 1, &rule21},-	{541, 1, &rule22},-	{542, 1, &rule21},-	{543, 1, &rule22},-	{544, 1, &rule53},-	{545, 1, &rule14},-	{546, 1, &rule21},-	{547, 1, &rule22},-	{548, 1, &rule21},-	{549, 1, &rule22},-	{550, 1, &rule21},-	{551, 1, &rule22},-	{552, 1, &rule21},-	{553, 1, &rule22},-	{554, 1, &rule21},-	{555, 1, &rule22},-	{556, 1, &rule21},-	{557, 1, &rule22},-	{558, 1, &rule21},-	{559, 1, &rule22},-	{560, 1, &rule21},-	{561, 1, &rule22},-	{562, 1, &rule21},-	{563, 1, &rule22},-	{564, 6, &rule14},-	{570, 1, &rule54},-	{571, 1, &rule21},-	{572, 1, &rule22},-	{573, 1, &rule55},-	{574, 1, &rule56},-	{575, 2, &rule14},-	{577, 1, &rule21},-	{578, 1, &rule22},-	{579, 1, &rule57},-	{580, 1, &rule58},-	{581, 1, &rule59},-	{582, 1, &rule21},-	{583, 1, &rule22},-	{584, 1, &rule21},-	{585, 1, &rule22},-	{586, 1, &rule21},-	{587, 1, &rule22},-	{588, 1, &rule21},-	{589, 1, &rule22},-	{590, 1, &rule21},-	{591, 1, &rule22},-	{592, 1, &rule60},-	{593, 1, &rule61},-	{594, 1, &rule14},-	{595, 1, &rule62},-	{596, 1, &rule63},-	{597, 1, &rule14},-	{598, 2, &rule64},-	{600, 1, &rule14},-	{601, 1, &rule65},-	{602, 1, &rule14},-	{603, 1, &rule66},-	{604, 4, &rule14},-	{608, 1, &rule64},-	{609, 2, &rule14},-	{611, 1, &rule67},-	{612, 4, &rule14},-	{616, 1, &rule68},-	{617, 1, &rule69},-	{618, 1, &rule14},-	{619, 1, &rule70},-	{620, 3, &rule14},-	{623, 1, &rule69},-	{624, 1, &rule14},-	{625, 1, &rule71},-	{626, 1, &rule72},-	{627, 2, &rule14},-	{629, 1, &rule73},-	{630, 7, &rule14},-	{637, 1, &rule74},-	{638, 2, &rule14},-	{640, 1, &rule75},-	{641, 2, &rule14},-	{643, 1, &rule75},-	{644, 4, &rule14},-	{648, 1, &rule75},-	{649, 1, &rule76},-	{650, 2, &rule77},-	{652, 1, &rule78},-	{653, 5, &rule14},-	{658, 1, &rule79},-	{659, 1, &rule14},-	{660, 1, &rule45},-	{661, 27, &rule14},-	{688, 18, &rule80},-	{706, 4, &rule10},-	{710, 12, &rule80},-	{722, 14, &rule10},-	{736, 5, &rule80},-	{741, 7, &rule10},-	{748, 1, &rule80},-	{749, 1, &rule10},-	{750, 1, &rule80},-	{751, 17, &rule10},-	{768, 69, &rule81},-	{837, 1, &rule82},-	{838, 42, &rule81},-	{880, 1, &rule21},-	{881, 1, &rule22},-	{882, 1, &rule21},-	{883, 1, &rule22},-	{884, 1, &rule80},-	{885, 1, &rule10},-	{886, 1, &rule21},-	{887, 1, &rule22},-	{890, 1, &rule80},-	{891, 3, &rule40},-	{894, 1, &rule2},-	{900, 2, &rule10},-	{902, 1, &rule83},-	{903, 1, &rule2},-	{904, 3, &rule84},-	{908, 1, &rule85},-	{910, 2, &rule86},-	{912, 1, &rule14},-	{913, 17, &rule9},-	{931, 9, &rule9},-	{940, 1, &rule87},-	{941, 3, &rule88},-	{944, 1, &rule14},-	{945, 17, &rule12},-	{962, 1, &rule89},-	{963, 9, &rule12},-	{972, 1, &rule90},-	{973, 2, &rule91},-	{975, 1, &rule92},-	{976, 1, &rule93},-	{977, 1, &rule94},-	{978, 3, &rule95},-	{981, 1, &rule96},-	{982, 1, &rule97},-	{983, 1, &rule98},-	{984, 1, &rule21},-	{985, 1, &rule22},-	{986, 1, &rule21},-	{987, 1, &rule22},-	{988, 1, &rule21},-	{989, 1, &rule22},-	{990, 1, &rule21},-	{991, 1, &rule22},-	{992, 1, &rule21},-	{993, 1, &rule22},-	{994, 1, &rule21},-	{995, 1, &rule22},-	{996, 1, &rule21},-	{997, 1, &rule22},-	{998, 1, &rule21},-	{999, 1, &rule22},-	{1000, 1, &rule21},-	{1001, 1, &rule22},-	{1002, 1, &rule21},-	{1003, 1, &rule22},-	{1004, 1, &rule21},-	{1005, 1, &rule22},-	{1006, 1, &rule21},-	{1007, 1, &rule22},-	{1008, 1, &rule99},-	{1009, 1, &rule100},-	{1010, 1, &rule101},-	{1011, 1, &rule14},-	{1012, 1, &rule102},-	{1013, 1, &rule103},-	{1014, 1, &rule6},-	{1015, 1, &rule21},-	{1016, 1, &rule22},-	{1017, 1, &rule104},-	{1018, 1, &rule21},-	{1019, 1, &rule22},-	{1020, 1, &rule14},-	{1021, 3, &rule53},-	{1024, 16, &rule105},-	{1040, 32, &rule9},-	{1072, 32, &rule12},-	{1104, 16, &rule100},-	{1120, 1, &rule21},-	{1121, 1, &rule22},-	{1122, 1, &rule21},-	{1123, 1, &rule22},-	{1124, 1, &rule21},-	{1125, 1, &rule22},-	{1126, 1, &rule21},-	{1127, 1, &rule22},-	{1128, 1, &rule21},-	{1129, 1, &rule22},-	{1130, 1, &rule21},-	{1131, 1, &rule22},-	{1132, 1, &rule21},-	{1133, 1, &rule22},-	{1134, 1, &rule21},-	{1135, 1, &rule22},-	{1136, 1, &rule21},-	{1137, 1, &rule22},-	{1138, 1, &rule21},-	{1139, 1, &rule22},-	{1140, 1, &rule21},-	{1141, 1, &rule22},-	{1142, 1, &rule21},-	{1143, 1, &rule22},-	{1144, 1, &rule21},-	{1145, 1, &rule22},-	{1146, 1, &rule21},-	{1147, 1, &rule22},-	{1148, 1, &rule21},-	{1149, 1, &rule22},-	{1150, 1, &rule21},-	{1151, 1, &rule22},-	{1152, 1, &rule21},-	{1153, 1, &rule22},-	{1154, 1, &rule13},-	{1155, 5, &rule81},-	{1160, 2, &rule106},-	{1162, 1, &rule21},-	{1163, 1, &rule22},-	{1164, 1, &rule21},-	{1165, 1, &rule22},-	{1166, 1, &rule21},-	{1167, 1, &rule22},-	{1168, 1, &rule21},-	{1169, 1, &rule22},-	{1170, 1, &rule21},-	{1171, 1, &rule22},-	{1172, 1, &rule21},-	{1173, 1, &rule22},-	{1174, 1, &rule21},-	{1175, 1, &rule22},-	{1176, 1, &rule21},-	{1177, 1, &rule22},-	{1178, 1, &rule21},-	{1179, 1, &rule22},-	{1180, 1, &rule21},-	{1181, 1, &rule22},-	{1182, 1, &rule21},-	{1183, 1, &rule22},-	{1184, 1, &rule21},-	{1185, 1, &rule22},-	{1186, 1, &rule21},-	{1187, 1, &rule22},-	{1188, 1, &rule21},-	{1189, 1, &rule22},-	{1190, 1, &rule21},-	{1191, 1, &rule22},-	{1192, 1, &rule21},-	{1193, 1, &rule22},-	{1194, 1, &rule21},-	{1195, 1, &rule22},-	{1196, 1, &rule21},-	{1197, 1, &rule22},-	{1198, 1, &rule21},-	{1199, 1, &rule22},-	{1200, 1, &rule21},-	{1201, 1, &rule22},-	{1202, 1, &rule21},-	{1203, 1, &rule22},-	{1204, 1, &rule21},-	{1205, 1, &rule22},-	{1206, 1, &rule21},-	{1207, 1, &rule22},-	{1208, 1, &rule21},-	{1209, 1, &rule22},-	{1210, 1, &rule21},-	{1211, 1, &rule22},-	{1212, 1, &rule21},-	{1213, 1, &rule22},-	{1214, 1, &rule21},-	{1215, 1, &rule22},-	{1216, 1, &rule107},-	{1217, 1, &rule21},-	{1218, 1, &rule22},-	{1219, 1, &rule21},-	{1220, 1, &rule22},-	{1221, 1, &rule21},-	{1222, 1, &rule22},-	{1223, 1, &rule21},-	{1224, 1, &rule22},-	{1225, 1, &rule21},-	{1226, 1, &rule22},-	{1227, 1, &rule21},-	{1228, 1, &rule22},-	{1229, 1, &rule21},-	{1230, 1, &rule22},-	{1231, 1, &rule108},-	{1232, 1, &rule21},-	{1233, 1, &rule22},-	{1234, 1, &rule21},-	{1235, 1, &rule22},-	{1236, 1, &rule21},-	{1237, 1, &rule22},-	{1238, 1, &rule21},-	{1239, 1, &rule22},-	{1240, 1, &rule21},-	{1241, 1, &rule22},-	{1242, 1, &rule21},-	{1243, 1, &rule22},-	{1244, 1, &rule21},-	{1245, 1, &rule22},-	{1246, 1, &rule21},-	{1247, 1, &rule22},-	{1248, 1, &rule21},-	{1249, 1, &rule22},-	{1250, 1, &rule21},-	{1251, 1, &rule22},-	{1252, 1, &rule21},-	{1253, 1, &rule22},-	{1254, 1, &rule21},-	{1255, 1, &rule22},-	{1256, 1, &rule21},-	{1257, 1, &rule22},-	{1258, 1, &rule21},-	{1259, 1, &rule22},-	{1260, 1, &rule21},-	{1261, 1, &rule22},-	{1262, 1, &rule21},-	{1263, 1, &rule22},-	{1264, 1, &rule21},-	{1265, 1, &rule22},-	{1266, 1, &rule21},-	{1267, 1, &rule22},-	{1268, 1, &rule21},-	{1269, 1, &rule22},-	{1270, 1, &rule21},-	{1271, 1, &rule22},-	{1272, 1, &rule21},-	{1273, 1, &rule22},-	{1274, 1, &rule21},-	{1275, 1, &rule22},-	{1276, 1, &rule21},-	{1277, 1, &rule22},-	{1278, 1, &rule21},-	{1279, 1, &rule22},-	{1280, 1, &rule21},-	{1281, 1, &rule22},-	{1282, 1, &rule21},-	{1283, 1, &rule22},-	{1284, 1, &rule21},-	{1285, 1, &rule22},-	{1286, 1, &rule21},-	{1287, 1, &rule22},-	{1288, 1, &rule21},-	{1289, 1, &rule22},-	{1290, 1, &rule21},-	{1291, 1, &rule22},-	{1292, 1, &rule21},-	{1293, 1, &rule22},-	{1294, 1, &rule21},-	{1295, 1, &rule22},-	{1296, 1, &rule21},-	{1297, 1, &rule22},-	{1298, 1, &rule21},-	{1299, 1, &rule22},-	{1300, 1, &rule21},-	{1301, 1, &rule22},-	{1302, 1, &rule21},-	{1303, 1, &rule22},-	{1304, 1, &rule21},-	{1305, 1, &rule22},-	{1306, 1, &rule21},-	{1307, 1, &rule22},-	{1308, 1, &rule21},-	{1309, 1, &rule22},-	{1310, 1, &rule21},-	{1311, 1, &rule22},-	{1312, 1, &rule21},-	{1313, 1, &rule22},-	{1314, 1, &rule21},-	{1315, 1, &rule22},-	{1329, 38, &rule109},-	{1369, 1, &rule80},-	{1370, 6, &rule2},-	{1377, 38, &rule110},-	{1415, 1, &rule14},-	{1417, 1, &rule2},-	{1418, 1, &rule7},-	{1425, 45, &rule81},-	{1470, 1, &rule7},-	{1471, 1, &rule81},-	{1472, 1, &rule2},-	{1473, 2, &rule81},-	{1475, 1, &rule2},-	{1476, 2, &rule81},-	{1478, 1, &rule2},-	{1479, 1, &rule81},-	{1488, 27, &rule45},-	{1520, 3, &rule45},-	{1523, 2, &rule2},-	{1536, 4, &rule16},-	{1542, 3, &rule6},-	{1545, 2, &rule2},-	{1547, 1, &rule3},-	{1548, 2, &rule2},-	{1550, 2, &rule13},-	{1552, 11, &rule81},-	{1563, 1, &rule2},-	{1566, 2, &rule2},-	{1569, 31, &rule45},-	{1600, 1, &rule80},-	{1601, 10, &rule45},-	{1611, 20, &rule81},-	{1632, 10, &rule8},-	{1642, 4, &rule2},-	{1646, 2, &rule45},-	{1648, 1, &rule81},-	{1649, 99, &rule45},-	{1748, 1, &rule2},-	{1749, 1, &rule45},-	{1750, 7, &rule81},-	{1757, 1, &rule16},-	{1758, 1, &rule106},-	{1759, 6, &rule81},-	{1765, 2, &rule80},-	{1767, 2, &rule81},-	{1769, 1, &rule13},-	{1770, 4, &rule81},-	{1774, 2, &rule45},-	{1776, 10, &rule8},-	{1786, 3, &rule45},-	{1789, 2, &rule13},-	{1791, 1, &rule45},-	{1792, 14, &rule2},-	{1807, 1, &rule16},-	{1808, 1, &rule45},-	{1809, 1, &rule81},-	{1810, 30, &rule45},-	{1840, 27, &rule81},-	{1869, 89, &rule45},-	{1958, 11, &rule81},-	{1969, 1, &rule45},-	{1984, 10, &rule8},-	{1994, 33, &rule45},-	{2027, 9, &rule81},-	{2036, 2, &rule80},-	{2038, 1, &rule13},-	{2039, 3, &rule2},-	{2042, 1, &rule80},-	{2305, 2, &rule81},-	{2307, 1, &rule111},-	{2308, 54, &rule45},-	{2364, 1, &rule81},-	{2365, 1, &rule45},-	{2366, 3, &rule111},-	{2369, 8, &rule81},-	{2377, 4, &rule111},-	{2381, 1, &rule81},-	{2384, 1, &rule45},-	{2385, 4, &rule81},-	{2392, 10, &rule45},-	{2402, 2, &rule81},-	{2404, 2, &rule2},-	{2406, 10, &rule8},-	{2416, 1, &rule2},-	{2417, 1, &rule80},-	{2418, 1, &rule45},-	{2427, 5, &rule45},-	{2433, 1, &rule81},-	{2434, 2, &rule111},-	{2437, 8, &rule45},-	{2447, 2, &rule45},-	{2451, 22, &rule45},-	{2474, 7, &rule45},-	{2482, 1, &rule45},-	{2486, 4, &rule45},-	{2492, 1, &rule81},-	{2493, 1, &rule45},-	{2494, 3, &rule111},-	{2497, 4, &rule81},-	{2503, 2, &rule111},-	{2507, 2, &rule111},-	{2509, 1, &rule81},-	{2510, 1, &rule45},-	{2519, 1, &rule111},-	{2524, 2, &rule45},-	{2527, 3, &rule45},-	{2530, 2, &rule81},-	{2534, 10, &rule8},-	{2544, 2, &rule45},-	{2546, 2, &rule3},-	{2548, 6, &rule17},-	{2554, 1, &rule13},-	{2561, 2, &rule81},-	{2563, 1, &rule111},-	{2565, 6, &rule45},-	{2575, 2, &rule45},-	{2579, 22, &rule45},-	{2602, 7, &rule45},-	{2610, 2, &rule45},-	{2613, 2, &rule45},-	{2616, 2, &rule45},-	{2620, 1, &rule81},-	{2622, 3, &rule111},-	{2625, 2, &rule81},-	{2631, 2, &rule81},-	{2635, 3, &rule81},-	{2641, 1, &rule81},-	{2649, 4, &rule45},-	{2654, 1, &rule45},-	{2662, 10, &rule8},-	{2672, 2, &rule81},-	{2674, 3, &rule45},-	{2677, 1, &rule81},-	{2689, 2, &rule81},-	{2691, 1, &rule111},-	{2693, 9, &rule45},-	{2703, 3, &rule45},-	{2707, 22, &rule45},-	{2730, 7, &rule45},-	{2738, 2, &rule45},-	{2741, 5, &rule45},-	{2748, 1, &rule81},-	{2749, 1, &rule45},-	{2750, 3, &rule111},-	{2753, 5, &rule81},-	{2759, 2, &rule81},-	{2761, 1, &rule111},-	{2763, 2, &rule111},-	{2765, 1, &rule81},-	{2768, 1, &rule45},-	{2784, 2, &rule45},-	{2786, 2, &rule81},-	{2790, 10, &rule8},-	{2801, 1, &rule3},-	{2817, 1, &rule81},-	{2818, 2, &rule111},-	{2821, 8, &rule45},-	{2831, 2, &rule45},-	{2835, 22, &rule45},-	{2858, 7, &rule45},-	{2866, 2, &rule45},-	{2869, 5, &rule45},-	{2876, 1, &rule81},-	{2877, 1, &rule45},-	{2878, 1, &rule111},-	{2879, 1, &rule81},-	{2880, 1, &rule111},-	{2881, 4, &rule81},-	{2887, 2, &rule111},-	{2891, 2, &rule111},-	{2893, 1, &rule81},-	{2902, 1, &rule81},-	{2903, 1, &rule111},-	{2908, 2, &rule45},-	{2911, 3, &rule45},-	{2914, 2, &rule81},-	{2918, 10, &rule8},-	{2928, 1, &rule13},-	{2929, 1, &rule45},-	{2946, 1, &rule81},-	{2947, 1, &rule45},-	{2949, 6, &rule45},-	{2958, 3, &rule45},-	{2962, 4, &rule45},-	{2969, 2, &rule45},-	{2972, 1, &rule45},-	{2974, 2, &rule45},-	{2979, 2, &rule45},-	{2984, 3, &rule45},-	{2990, 12, &rule45},-	{3006, 2, &rule111},-	{3008, 1, &rule81},-	{3009, 2, &rule111},-	{3014, 3, &rule111},-	{3018, 3, &rule111},-	{3021, 1, &rule81},-	{3024, 1, &rule45},-	{3031, 1, &rule111},-	{3046, 10, &rule8},-	{3056, 3, &rule17},-	{3059, 6, &rule13},-	{3065, 1, &rule3},-	{3066, 1, &rule13},-	{3073, 3, &rule111},-	{3077, 8, &rule45},-	{3086, 3, &rule45},-	{3090, 23, &rule45},-	{3114, 10, &rule45},-	{3125, 5, &rule45},-	{3133, 1, &rule45},-	{3134, 3, &rule81},-	{3137, 4, &rule111},-	{3142, 3, &rule81},-	{3146, 4, &rule81},-	{3157, 2, &rule81},-	{3160, 2, &rule45},-	{3168, 2, &rule45},-	{3170, 2, &rule81},-	{3174, 10, &rule8},-	{3192, 7, &rule17},-	{3199, 1, &rule13},-	{3202, 2, &rule111},-	{3205, 8, &rule45},-	{3214, 3, &rule45},-	{3218, 23, &rule45},-	{3242, 10, &rule45},-	{3253, 5, &rule45},-	{3260, 1, &rule81},-	{3261, 1, &rule45},-	{3262, 1, &rule111},-	{3263, 1, &rule81},-	{3264, 5, &rule111},-	{3270, 1, &rule81},-	{3271, 2, &rule111},-	{3274, 2, &rule111},-	{3276, 2, &rule81},-	{3285, 2, &rule111},-	{3294, 1, &rule45},-	{3296, 2, &rule45},-	{3298, 2, &rule81},-	{3302, 10, &rule8},-	{3313, 2, &rule13},-	{3330, 2, &rule111},-	{3333, 8, &rule45},-	{3342, 3, &rule45},-	{3346, 23, &rule45},-	{3370, 16, &rule45},-	{3389, 1, &rule45},-	{3390, 3, &rule111},-	{3393, 4, &rule81},-	{3398, 3, &rule111},-	{3402, 3, &rule111},-	{3405, 1, &rule81},-	{3415, 1, &rule111},-	{3424, 2, &rule45},-	{3426, 2, &rule81},-	{3430, 10, &rule8},-	{3440, 6, &rule17},-	{3449, 1, &rule13},-	{3450, 6, &rule45},-	{3458, 2, &rule111},-	{3461, 18, &rule45},-	{3482, 24, &rule45},-	{3507, 9, &rule45},-	{3517, 1, &rule45},-	{3520, 7, &rule45},-	{3530, 1, &rule81},-	{3535, 3, &rule111},-	{3538, 3, &rule81},-	{3542, 1, &rule81},-	{3544, 8, &rule111},-	{3570, 2, &rule111},-	{3572, 1, &rule2},-	{3585, 48, &rule45},-	{3633, 1, &rule81},-	{3634, 2, &rule45},-	{3636, 7, &rule81},-	{3647, 1, &rule3},-	{3648, 6, &rule45},-	{3654, 1, &rule80},-	{3655, 8, &rule81},-	{3663, 1, &rule2},-	{3664, 10, &rule8},-	{3674, 2, &rule2},-	{3713, 2, &rule45},-	{3716, 1, &rule45},-	{3719, 2, &rule45},-	{3722, 1, &rule45},-	{3725, 1, &rule45},-	{3732, 4, &rule45},-	{3737, 7, &rule45},-	{3745, 3, &rule45},-	{3749, 1, &rule45},-	{3751, 1, &rule45},-	{3754, 2, &rule45},-	{3757, 4, &rule45},-	{3761, 1, &rule81},-	{3762, 2, &rule45},-	{3764, 6, &rule81},-	{3771, 2, &rule81},-	{3773, 1, &rule45},-	{3776, 5, &rule45},-	{3782, 1, &rule80},-	{3784, 6, &rule81},-	{3792, 10, &rule8},-	{3804, 2, &rule45},-	{3840, 1, &rule45},-	{3841, 3, &rule13},-	{3844, 15, &rule2},-	{3859, 5, &rule13},-	{3864, 2, &rule81},-	{3866, 6, &rule13},-	{3872, 10, &rule8},-	{3882, 10, &rule17},-	{3892, 1, &rule13},-	{3893, 1, &rule81},-	{3894, 1, &rule13},-	{3895, 1, &rule81},-	{3896, 1, &rule13},-	{3897, 1, &rule81},-	{3898, 1, &rule4},-	{3899, 1, &rule5},-	{3900, 1, &rule4},-	{3901, 1, &rule5},-	{3902, 2, &rule111},-	{3904, 8, &rule45},-	{3913, 36, &rule45},-	{3953, 14, &rule81},-	{3967, 1, &rule111},-	{3968, 5, &rule81},-	{3973, 1, &rule2},-	{3974, 2, &rule81},-	{3976, 4, &rule45},-	{3984, 8, &rule81},-	{3993, 36, &rule81},-	{4030, 8, &rule13},-	{4038, 1, &rule81},-	{4039, 6, &rule13},-	{4046, 2, &rule13},-	{4048, 5, &rule2},-	{4096, 43, &rule45},-	{4139, 2, &rule111},-	{4141, 4, &rule81},-	{4145, 1, &rule111},-	{4146, 6, &rule81},-	{4152, 1, &rule111},-	{4153, 2, &rule81},-	{4155, 2, &rule111},-	{4157, 2, &rule81},-	{4159, 1, &rule45},-	{4160, 10, &rule8},-	{4170, 6, &rule2},-	{4176, 6, &rule45},-	{4182, 2, &rule111},-	{4184, 2, &rule81},-	{4186, 4, &rule45},-	{4190, 3, &rule81},-	{4193, 1, &rule45},-	{4194, 3, &rule111},-	{4197, 2, &rule45},-	{4199, 7, &rule111},-	{4206, 3, &rule45},-	{4209, 4, &rule81},-	{4213, 13, &rule45},-	{4226, 1, &rule81},-	{4227, 2, &rule111},-	{4229, 2, &rule81},-	{4231, 6, &rule111},-	{4237, 1, &rule81},-	{4238, 1, &rule45},-	{4239, 1, &rule111},-	{4240, 10, &rule8},-	{4254, 2, &rule13},-	{4256, 38, &rule112},-	{4304, 43, &rule45},-	{4347, 1, &rule2},-	{4348, 1, &rule80},-	{4352, 90, &rule45},-	{4447, 68, &rule45},-	{4520, 82, &rule45},-	{4608, 73, &rule45},-	{4682, 4, &rule45},-	{4688, 7, &rule45},-	{4696, 1, &rule45},-	{4698, 4, &rule45},-	{4704, 41, &rule45},-	{4746, 4, &rule45},-	{4752, 33, &rule45},-	{4786, 4, &rule45},-	{4792, 7, &rule45},-	{4800, 1, &rule45},-	{4802, 4, &rule45},-	{4808, 15, &rule45},-	{4824, 57, &rule45},-	{4882, 4, &rule45},-	{4888, 67, &rule45},-	{4959, 1, &rule81},-	{4960, 1, &rule13},-	{4961, 8, &rule2},-	{4969, 20, &rule17},-	{4992, 16, &rule45},-	{5008, 10, &rule13},-	{5024, 85, &rule45},-	{5121, 620, &rule45},-	{5741, 2, &rule2},-	{5743, 8, &rule45},-	{5760, 1, &rule1},-	{5761, 26, &rule45},-	{5787, 1, &rule4},-	{5788, 1, &rule5},-	{5792, 75, &rule45},-	{5867, 3, &rule2},-	{5870, 3, &rule113},-	{5888, 13, &rule45},-	{5902, 4, &rule45},-	{5906, 3, &rule81},-	{5920, 18, &rule45},-	{5938, 3, &rule81},-	{5941, 2, &rule2},-	{5952, 18, &rule45},-	{5970, 2, &rule81},-	{5984, 13, &rule45},-	{5998, 3, &rule45},-	{6002, 2, &rule81},-	{6016, 52, &rule45},-	{6068, 2, &rule16},-	{6070, 1, &rule111},-	{6071, 7, &rule81},-	{6078, 8, &rule111},-	{6086, 1, &rule81},-	{6087, 2, &rule111},-	{6089, 11, &rule81},-	{6100, 3, &rule2},-	{6103, 1, &rule80},-	{6104, 3, &rule2},-	{6107, 1, &rule3},-	{6108, 1, &rule45},-	{6109, 1, &rule81},-	{6112, 10, &rule8},-	{6128, 10, &rule17},-	{6144, 6, &rule2},-	{6150, 1, &rule7},-	{6151, 4, &rule2},-	{6155, 3, &rule81},-	{6158, 1, &rule1},-	{6160, 10, &rule8},-	{6176, 35, &rule45},-	{6211, 1, &rule80},-	{6212, 52, &rule45},-	{6272, 41, &rule45},-	{6313, 1, &rule81},-	{6314, 1, &rule45},-	{6400, 29, &rule45},-	{6432, 3, &rule81},-	{6435, 4, &rule111},-	{6439, 2, &rule81},-	{6441, 3, &rule111},-	{6448, 2, &rule111},-	{6450, 1, &rule81},-	{6451, 6, &rule111},-	{6457, 3, &rule81},-	{6464, 1, &rule13},-	{6468, 2, &rule2},-	{6470, 10, &rule8},-	{6480, 30, &rule45},-	{6512, 5, &rule45},-	{6528, 42, &rule45},-	{6576, 17, &rule111},-	{6593, 7, &rule45},-	{6600, 2, &rule111},-	{6608, 10, &rule8},-	{6622, 2, &rule2},-	{6624, 32, &rule13},-	{6656, 23, &rule45},-	{6679, 2, &rule81},-	{6681, 3, &rule111},-	{6686, 2, &rule2},-	{6912, 4, &rule81},-	{6916, 1, &rule111},-	{6917, 47, &rule45},-	{6964, 1, &rule81},-	{6965, 1, &rule111},-	{6966, 5, &rule81},-	{6971, 1, &rule111},-	{6972, 1, &rule81},-	{6973, 5, &rule111},-	{6978, 1, &rule81},-	{6979, 2, &rule111},-	{6981, 7, &rule45},-	{6992, 10, &rule8},-	{7002, 7, &rule2},-	{7009, 10, &rule13},-	{7019, 9, &rule81},-	{7028, 9, &rule13},-	{7040, 2, &rule81},-	{7042, 1, &rule111},-	{7043, 30, &rule45},-	{7073, 1, &rule111},-	{7074, 4, &rule81},-	{7078, 2, &rule111},-	{7080, 2, &rule81},-	{7082, 1, &rule111},-	{7086, 2, &rule45},-	{7088, 10, &rule8},-	{7168, 36, &rule45},-	{7204, 8, &rule111},-	{7212, 8, &rule81},-	{7220, 2, &rule111},-	{7222, 2, &rule81},-	{7227, 5, &rule2},-	{7232, 10, &rule8},-	{7245, 3, &rule45},-	{7248, 10, &rule8},-	{7258, 30, &rule45},-	{7288, 6, &rule80},-	{7294, 2, &rule2},-	{7424, 44, &rule14},-	{7468, 54, &rule80},-	{7522, 22, &rule14},-	{7544, 1, &rule80},-	{7545, 1, &rule114},-	{7546, 3, &rule14},-	{7549, 1, &rule115},-	{7550, 29, &rule14},-	{7579, 37, &rule80},-	{7616, 39, &rule81},-	{7678, 2, &rule81},-	{7680, 1, &rule21},-	{7681, 1, &rule22},-	{7682, 1, &rule21},-	{7683, 1, &rule22},-	{7684, 1, &rule21},-	{7685, 1, &rule22},-	{7686, 1, &rule21},-	{7687, 1, &rule22},-	{7688, 1, &rule21},-	{7689, 1, &rule22},-	{7690, 1, &rule21},-	{7691, 1, &rule22},-	{7692, 1, &rule21},-	{7693, 1, &rule22},-	{7694, 1, &rule21},-	{7695, 1, &rule22},-	{7696, 1, &rule21},-	{7697, 1, &rule22},-	{7698, 1, &rule21},-	{7699, 1, &rule22},-	{7700, 1, &rule21},-	{7701, 1, &rule22},-	{7702, 1, &rule21},-	{7703, 1, &rule22},-	{7704, 1, &rule21},-	{7705, 1, &rule22},-	{7706, 1, &rule21},-	{7707, 1, &rule22},-	{7708, 1, &rule21},-	{7709, 1, &rule22},-	{7710, 1, &rule21},-	{7711, 1, &rule22},-	{7712, 1, &rule21},-	{7713, 1, &rule22},-	{7714, 1, &rule21},-	{7715, 1, &rule22},-	{7716, 1, &rule21},-	{7717, 1, &rule22},-	{7718, 1, &rule21},-	{7719, 1, &rule22},-	{7720, 1, &rule21},-	{7721, 1, &rule22},-	{7722, 1, &rule21},-	{7723, 1, &rule22},-	{7724, 1, &rule21},-	{7725, 1, &rule22},-	{7726, 1, &rule21},-	{7727, 1, &rule22},-	{7728, 1, &rule21},-	{7729, 1, &rule22},-	{7730, 1, &rule21},-	{7731, 1, &rule22},-	{7732, 1, &rule21},-	{7733, 1, &rule22},-	{7734, 1, &rule21},-	{7735, 1, &rule22},-	{7736, 1, &rule21},-	{7737, 1, &rule22},-	{7738, 1, &rule21},-	{7739, 1, &rule22},-	{7740, 1, &rule21},-	{7741, 1, &rule22},-	{7742, 1, &rule21},-	{7743, 1, &rule22},-	{7744, 1, &rule21},-	{7745, 1, &rule22},-	{7746, 1, &rule21},-	{7747, 1, &rule22},-	{7748, 1, &rule21},-	{7749, 1, &rule22},-	{7750, 1, &rule21},-	{7751, 1, &rule22},-	{7752, 1, &rule21},-	{7753, 1, &rule22},-	{7754, 1, &rule21},-	{7755, 1, &rule22},-	{7756, 1, &rule21},-	{7757, 1, &rule22},-	{7758, 1, &rule21},-	{7759, 1, &rule22},-	{7760, 1, &rule21},-	{7761, 1, &rule22},-	{7762, 1, &rule21},-	{7763, 1, &rule22},-	{7764, 1, &rule21},-	{7765, 1, &rule22},-	{7766, 1, &rule21},-	{7767, 1, &rule22},-	{7768, 1, &rule21},-	{7769, 1, &rule22},-	{7770, 1, &rule21},-	{7771, 1, &rule22},-	{7772, 1, &rule21},-	{7773, 1, &rule22},-	{7774, 1, &rule21},-	{7775, 1, &rule22},-	{7776, 1, &rule21},-	{7777, 1, &rule22},-	{7778, 1, &rule21},-	{7779, 1, &rule22},-	{7780, 1, &rule21},-	{7781, 1, &rule22},-	{7782, 1, &rule21},-	{7783, 1, &rule22},-	{7784, 1, &rule21},-	{7785, 1, &rule22},-	{7786, 1, &rule21},-	{7787, 1, &rule22},-	{7788, 1, &rule21},-	{7789, 1, &rule22},-	{7790, 1, &rule21},-	{7791, 1, &rule22},-	{7792, 1, &rule21},-	{7793, 1, &rule22},-	{7794, 1, &rule21},-	{7795, 1, &rule22},-	{7796, 1, &rule21},-	{7797, 1, &rule22},-	{7798, 1, &rule21},-	{7799, 1, &rule22},-	{7800, 1, &rule21},-	{7801, 1, &rule22},-	{7802, 1, &rule21},-	{7803, 1, &rule22},-	{7804, 1, &rule21},-	{7805, 1, &rule22},-	{7806, 1, &rule21},-	{7807, 1, &rule22},-	{7808, 1, &rule21},-	{7809, 1, &rule22},-	{7810, 1, &rule21},-	{7811, 1, &rule22},-	{7812, 1, &rule21},-	{7813, 1, &rule22},-	{7814, 1, &rule21},-	{7815, 1, &rule22},-	{7816, 1, &rule21},-	{7817, 1, &rule22},-	{7818, 1, &rule21},-	{7819, 1, &rule22},-	{7820, 1, &rule21},-	{7821, 1, &rule22},-	{7822, 1, &rule21},-	{7823, 1, &rule22},-	{7824, 1, &rule21},-	{7825, 1, &rule22},-	{7826, 1, &rule21},-	{7827, 1, &rule22},-	{7828, 1, &rule21},-	{7829, 1, &rule22},-	{7830, 5, &rule14},-	{7835, 1, &rule116},-	{7836, 2, &rule14},-	{7838, 1, &rule117},-	{7839, 1, &rule14},-	{7840, 1, &rule21},-	{7841, 1, &rule22},-	{7842, 1, &rule21},-	{7843, 1, &rule22},-	{7844, 1, &rule21},-	{7845, 1, &rule22},-	{7846, 1, &rule21},-	{7847, 1, &rule22},-	{7848, 1, &rule21},-	{7849, 1, &rule22},-	{7850, 1, &rule21},-	{7851, 1, &rule22},-	{7852, 1, &rule21},-	{7853, 1, &rule22},-	{7854, 1, &rule21},-	{7855, 1, &rule22},-	{7856, 1, &rule21},-	{7857, 1, &rule22},-	{7858, 1, &rule21},-	{7859, 1, &rule22},-	{7860, 1, &rule21},-	{7861, 1, &rule22},-	{7862, 1, &rule21},-	{7863, 1, &rule22},-	{7864, 1, &rule21},-	{7865, 1, &rule22},-	{7866, 1, &rule21},-	{7867, 1, &rule22},-	{7868, 1, &rule21},-	{7869, 1, &rule22},-	{7870, 1, &rule21},-	{7871, 1, &rule22},-	{7872, 1, &rule21},-	{7873, 1, &rule22},-	{7874, 1, &rule21},-	{7875, 1, &rule22},-	{7876, 1, &rule21},-	{7877, 1, &rule22},-	{7878, 1, &rule21},-	{7879, 1, &rule22},-	{7880, 1, &rule21},-	{7881, 1, &rule22},-	{7882, 1, &rule21},-	{7883, 1, &rule22},-	{7884, 1, &rule21},-	{7885, 1, &rule22},-	{7886, 1, &rule21},-	{7887, 1, &rule22},-	{7888, 1, &rule21},-	{7889, 1, &rule22},-	{7890, 1, &rule21},-	{7891, 1, &rule22},-	{7892, 1, &rule21},-	{7893, 1, &rule22},-	{7894, 1, &rule21},-	{7895, 1, &rule22},-	{7896, 1, &rule21},-	{7897, 1, &rule22},-	{7898, 1, &rule21},-	{7899, 1, &rule22},-	{7900, 1, &rule21},-	{7901, 1, &rule22},-	{7902, 1, &rule21},-	{7903, 1, &rule22},-	{7904, 1, &rule21},-	{7905, 1, &rule22},-	{7906, 1, &rule21},-	{7907, 1, &rule22},-	{7908, 1, &rule21},-	{7909, 1, &rule22},-	{7910, 1, &rule21},-	{7911, 1, &rule22},-	{7912, 1, &rule21},-	{7913, 1, &rule22},-	{7914, 1, &rule21},-	{7915, 1, &rule22},-	{7916, 1, &rule21},-	{7917, 1, &rule22},-	{7918, 1, &rule21},-	{7919, 1, &rule22},-	{7920, 1, &rule21},-	{7921, 1, &rule22},-	{7922, 1, &rule21},-	{7923, 1, &rule22},-	{7924, 1, &rule21},-	{7925, 1, &rule22},-	{7926, 1, &rule21},-	{7927, 1, &rule22},-	{7928, 1, &rule21},-	{7929, 1, &rule22},-	{7930, 1, &rule21},-	{7931, 1, &rule22},-	{7932, 1, &rule21},-	{7933, 1, &rule22},-	{7934, 1, &rule21},-	{7935, 1, &rule22},-	{7936, 8, &rule118},-	{7944, 8, &rule119},-	{7952, 6, &rule118},-	{7960, 6, &rule119},-	{7968, 8, &rule118},-	{7976, 8, &rule119},-	{7984, 8, &rule118},-	{7992, 8, &rule119},-	{8000, 6, &rule118},-	{8008, 6, &rule119},-	{8016, 1, &rule14},-	{8017, 1, &rule118},-	{8018, 1, &rule14},-	{8019, 1, &rule118},-	{8020, 1, &rule14},-	{8021, 1, &rule118},-	{8022, 1, &rule14},-	{8023, 1, &rule118},-	{8025, 1, &rule119},-	{8027, 1, &rule119},-	{8029, 1, &rule119},-	{8031, 1, &rule119},-	{8032, 8, &rule118},-	{8040, 8, &rule119},-	{8048, 2, &rule120},-	{8050, 4, &rule121},-	{8054, 2, &rule122},-	{8056, 2, &rule123},-	{8058, 2, &rule124},-	{8060, 2, &rule125},-	{8064, 8, &rule118},-	{8072, 8, &rule126},-	{8080, 8, &rule118},-	{8088, 8, &rule126},-	{8096, 8, &rule118},-	{8104, 8, &rule126},-	{8112, 2, &rule118},-	{8114, 1, &rule14},-	{8115, 1, &rule127},-	{8116, 1, &rule14},-	{8118, 2, &rule14},-	{8120, 2, &rule119},-	{8122, 2, &rule128},-	{8124, 1, &rule129},-	{8125, 1, &rule10},-	{8126, 1, &rule130},-	{8127, 3, &rule10},-	{8130, 1, &rule14},-	{8131, 1, &rule127},-	{8132, 1, &rule14},-	{8134, 2, &rule14},-	{8136, 4, &rule131},-	{8140, 1, &rule129},-	{8141, 3, &rule10},-	{8144, 2, &rule118},-	{8146, 2, &rule14},-	{8150, 2, &rule14},-	{8152, 2, &rule119},-	{8154, 2, &rule132},-	{8157, 3, &rule10},-	{8160, 2, &rule118},-	{8162, 3, &rule14},-	{8165, 1, &rule101},-	{8166, 2, &rule14},-	{8168, 2, &rule119},-	{8170, 2, &rule133},-	{8172, 1, &rule104},-	{8173, 3, &rule10},-	{8178, 1, &rule14},-	{8179, 1, &rule127},-	{8180, 1, &rule14},-	{8182, 2, &rule14},-	{8184, 2, &rule134},-	{8186, 2, &rule135},-	{8188, 1, &rule129},-	{8189, 2, &rule10},-	{8192, 11, &rule1},-	{8203, 5, &rule16},-	{8208, 6, &rule7},-	{8214, 2, &rule2},-	{8216, 1, &rule15},-	{8217, 1, &rule19},-	{8218, 1, &rule4},-	{8219, 2, &rule15},-	{8221, 1, &rule19},-	{8222, 1, &rule4},-	{8223, 1, &rule15},-	{8224, 8, &rule2},-	{8232, 1, &rule136},-	{8233, 1, &rule137},-	{8234, 5, &rule16},-	{8239, 1, &rule1},-	{8240, 9, &rule2},-	{8249, 1, &rule15},-	{8250, 1, &rule19},-	{8251, 4, &rule2},-	{8255, 2, &rule11},-	{8257, 3, &rule2},-	{8260, 1, &rule6},-	{8261, 1, &rule4},-	{8262, 1, &rule5},-	{8263, 11, &rule2},-	{8274, 1, &rule6},-	{8275, 1, &rule2},-	{8276, 1, &rule11},-	{8277, 10, &rule2},-	{8287, 1, &rule1},-	{8288, 5, &rule16},-	{8298, 6, &rule16},-	{8304, 1, &rule17},-	{8305, 1, &rule14},-	{8308, 6, &rule17},-	{8314, 3, &rule6},-	{8317, 1, &rule4},-	{8318, 1, &rule5},-	{8319, 1, &rule14},-	{8320, 10, &rule17},-	{8330, 3, &rule6},-	{8333, 1, &rule4},-	{8334, 1, &rule5},-	{8336, 5, &rule80},-	{8352, 22, &rule3},-	{8400, 13, &rule81},-	{8413, 4, &rule106},-	{8417, 1, &rule81},-	{8418, 3, &rule106},-	{8421, 12, &rule81},-	{8448, 2, &rule13},-	{8450, 1, &rule95},-	{8451, 4, &rule13},-	{8455, 1, &rule95},-	{8456, 2, &rule13},-	{8458, 1, &rule14},-	{8459, 3, &rule95},-	{8462, 2, &rule14},-	{8464, 3, &rule95},-	{8467, 1, &rule14},-	{8468, 1, &rule13},-	{8469, 1, &rule95},-	{8470, 3, &rule13},-	{8473, 5, &rule95},-	{8478, 6, &rule13},-	{8484, 1, &rule95},-	{8485, 1, &rule13},-	{8486, 1, &rule138},-	{8487, 1, &rule13},-	{8488, 1, &rule95},-	{8489, 1, &rule13},-	{8490, 1, &rule139},-	{8491, 1, &rule140},-	{8492, 2, &rule95},-	{8494, 1, &rule13},-	{8495, 1, &rule14},-	{8496, 2, &rule95},-	{8498, 1, &rule141},-	{8499, 1, &rule95},-	{8500, 1, &rule14},-	{8501, 4, &rule45},-	{8505, 1, &rule14},-	{8506, 2, &rule13},-	{8508, 2, &rule14},-	{8510, 2, &rule95},-	{8512, 5, &rule6},-	{8517, 1, &rule95},-	{8518, 4, &rule14},-	{8522, 1, &rule13},-	{8523, 1, &rule6},-	{8524, 2, &rule13},-	{8526, 1, &rule142},-	{8527, 1, &rule13},-	{8531, 13, &rule17},-	{8544, 16, &rule143},-	{8560, 16, &rule144},-	{8576, 3, &rule113},-	{8579, 1, &rule21},-	{8580, 1, &rule22},-	{8581, 4, &rule113},-	{8592, 5, &rule6},-	{8597, 5, &rule13},-	{8602, 2, &rule6},-	{8604, 4, &rule13},-	{8608, 1, &rule6},-	{8609, 2, &rule13},-	{8611, 1, &rule6},-	{8612, 2, &rule13},-	{8614, 1, &rule6},-	{8615, 7, &rule13},-	{8622, 1, &rule6},-	{8623, 31, &rule13},-	{8654, 2, &rule6},-	{8656, 2, &rule13},-	{8658, 1, &rule6},-	{8659, 1, &rule13},-	{8660, 1, &rule6},-	{8661, 31, &rule13},-	{8692, 268, &rule6},-	{8960, 8, &rule13},-	{8968, 4, &rule6},-	{8972, 20, &rule13},-	{8992, 2, &rule6},-	{8994, 7, &rule13},-	{9001, 1, &rule4},-	{9002, 1, &rule5},-	{9003, 81, &rule13},-	{9084, 1, &rule6},-	{9085, 30, &rule13},-	{9115, 25, &rule6},-	{9140, 40, &rule13},-	{9180, 6, &rule6},-	{9186, 6, &rule13},-	{9216, 39, &rule13},-	{9280, 11, &rule13},-	{9312, 60, &rule17},-	{9372, 26, &rule13},-	{9398, 26, &rule145},-	{9424, 26, &rule146},-	{9450, 22, &rule17},-	{9472, 183, &rule13},-	{9655, 1, &rule6},-	{9656, 9, &rule13},-	{9665, 1, &rule6},-	{9666, 54, &rule13},-	{9720, 8, &rule6},-	{9728, 111, &rule13},-	{9839, 1, &rule6},-	{9840, 46, &rule13},-	{9888, 29, &rule13},-	{9920, 4, &rule13},-	{9985, 4, &rule13},-	{9990, 4, &rule13},-	{9996, 28, &rule13},-	{10025, 35, &rule13},-	{10061, 1, &rule13},-	{10063, 4, &rule13},-	{10070, 1, &rule13},-	{10072, 7, &rule13},-	{10081, 7, &rule13},-	{10088, 1, &rule4},-	{10089, 1, &rule5},-	{10090, 1, &rule4},-	{10091, 1, &rule5},-	{10092, 1, &rule4},-	{10093, 1, &rule5},-	{10094, 1, &rule4},-	{10095, 1, &rule5},-	{10096, 1, &rule4},-	{10097, 1, &rule5},-	{10098, 1, &rule4},-	{10099, 1, &rule5},-	{10100, 1, &rule4},-	{10101, 1, &rule5},-	{10102, 30, &rule17},-	{10132, 1, &rule13},-	{10136, 24, &rule13},-	{10161, 14, &rule13},-	{10176, 5, &rule6},-	{10181, 1, &rule4},-	{10182, 1, &rule5},-	{10183, 4, &rule6},-	{10188, 1, &rule6},-	{10192, 22, &rule6},-	{10214, 1, &rule4},-	{10215, 1, &rule5},-	{10216, 1, &rule4},-	{10217, 1, &rule5},-	{10218, 1, &rule4},-	{10219, 1, &rule5},-	{10220, 1, &rule4},-	{10221, 1, &rule5},-	{10222, 1, &rule4},-	{10223, 1, &rule5},-	{10224, 16, &rule6},-	{10240, 256, &rule13},-	{10496, 131, &rule6},-	{10627, 1, &rule4},-	{10628, 1, &rule5},-	{10629, 1, &rule4},-	{10630, 1, &rule5},-	{10631, 1, &rule4},-	{10632, 1, &rule5},-	{10633, 1, &rule4},-	{10634, 1, &rule5},-	{10635, 1, &rule4},-	{10636, 1, &rule5},-	{10637, 1, &rule4},-	{10638, 1, &rule5},-	{10639, 1, &rule4},-	{10640, 1, &rule5},-	{10641, 1, &rule4},-	{10642, 1, &rule5},-	{10643, 1, &rule4},-	{10644, 1, &rule5},-	{10645, 1, &rule4},-	{10646, 1, &rule5},-	{10647, 1, &rule4},-	{10648, 1, &rule5},-	{10649, 63, &rule6},-	{10712, 1, &rule4},-	{10713, 1, &rule5},-	{10714, 1, &rule4},-	{10715, 1, &rule5},-	{10716, 32, &rule6},-	{10748, 1, &rule4},-	{10749, 1, &rule5},-	{10750, 258, &rule6},-	{11008, 48, &rule13},-	{11056, 21, &rule6},-	{11077, 2, &rule13},-	{11079, 6, &rule6},-	{11088, 5, &rule13},-	{11264, 47, &rule109},-	{11312, 47, &rule110},-	{11360, 1, &rule21},-	{11361, 1, &rule22},-	{11362, 1, &rule147},-	{11363, 1, &rule148},-	{11364, 1, &rule149},-	{11365, 1, &rule150},-	{11366, 1, &rule151},-	{11367, 1, &rule21},-	{11368, 1, &rule22},-	{11369, 1, &rule21},-	{11370, 1, &rule22},-	{11371, 1, &rule21},-	{11372, 1, &rule22},-	{11373, 1, &rule152},-	{11374, 1, &rule153},-	{11375, 1, &rule154},-	{11377, 1, &rule14},-	{11378, 1, &rule21},-	{11379, 1, &rule22},-	{11380, 1, &rule14},-	{11381, 1, &rule21},-	{11382, 1, &rule22},-	{11383, 6, &rule14},-	{11389, 1, &rule80},-	{11392, 1, &rule21},-	{11393, 1, &rule22},-	{11394, 1, &rule21},-	{11395, 1, &rule22},-	{11396, 1, &rule21},-	{11397, 1, &rule22},-	{11398, 1, &rule21},-	{11399, 1, &rule22},-	{11400, 1, &rule21},-	{11401, 1, &rule22},-	{11402, 1, &rule21},-	{11403, 1, &rule22},-	{11404, 1, &rule21},-	{11405, 1, &rule22},-	{11406, 1, &rule21},-	{11407, 1, &rule22},-	{11408, 1, &rule21},-	{11409, 1, &rule22},-	{11410, 1, &rule21},-	{11411, 1, &rule22},-	{11412, 1, &rule21},-	{11413, 1, &rule22},-	{11414, 1, &rule21},-	{11415, 1, &rule22},-	{11416, 1, &rule21},-	{11417, 1, &rule22},-	{11418, 1, &rule21},-	{11419, 1, &rule22},-	{11420, 1, &rule21},-	{11421, 1, &rule22},-	{11422, 1, &rule21},-	{11423, 1, &rule22},-	{11424, 1, &rule21},-	{11425, 1, &rule22},-	{11426, 1, &rule21},-	{11427, 1, &rule22},-	{11428, 1, &rule21},-	{11429, 1, &rule22},-	{11430, 1, &rule21},-	{11431, 1, &rule22},-	{11432, 1, &rule21},-	{11433, 1, &rule22},-	{11434, 1, &rule21},-	{11435, 1, &rule22},-	{11436, 1, &rule21},-	{11437, 1, &rule22},-	{11438, 1, &rule21},-	{11439, 1, &rule22},-	{11440, 1, &rule21},-	{11441, 1, &rule22},-	{11442, 1, &rule21},-	{11443, 1, &rule22},-	{11444, 1, &rule21},-	{11445, 1, &rule22},-	{11446, 1, &rule21},-	{11447, 1, &rule22},-	{11448, 1, &rule21},-	{11449, 1, &rule22},-	{11450, 1, &rule21},-	{11451, 1, &rule22},-	{11452, 1, &rule21},-	{11453, 1, &rule22},-	{11454, 1, &rule21},-	{11455, 1, &rule22},-	{11456, 1, &rule21},-	{11457, 1, &rule22},-	{11458, 1, &rule21},-	{11459, 1, &rule22},-	{11460, 1, &rule21},-	{11461, 1, &rule22},-	{11462, 1, &rule21},-	{11463, 1, &rule22},-	{11464, 1, &rule21},-	{11465, 1, &rule22},-	{11466, 1, &rule21},-	{11467, 1, &rule22},-	{11468, 1, &rule21},-	{11469, 1, &rule22},-	{11470, 1, &rule21},-	{11471, 1, &rule22},-	{11472, 1, &rule21},-	{11473, 1, &rule22},-	{11474, 1, &rule21},-	{11475, 1, &rule22},-	{11476, 1, &rule21},-	{11477, 1, &rule22},-	{11478, 1, &rule21},-	{11479, 1, &rule22},-	{11480, 1, &rule21},-	{11481, 1, &rule22},-	{11482, 1, &rule21},-	{11483, 1, &rule22},-	{11484, 1, &rule21},-	{11485, 1, &rule22},-	{11486, 1, &rule21},-	{11487, 1, &rule22},-	{11488, 1, &rule21},-	{11489, 1, &rule22},-	{11490, 1, &rule21},-	{11491, 1, &rule22},-	{11492, 1, &rule14},-	{11493, 6, &rule13},-	{11513, 4, &rule2},-	{11517, 1, &rule17},-	{11518, 2, &rule2},-	{11520, 38, &rule155},-	{11568, 54, &rule45},-	{11631, 1, &rule80},-	{11648, 23, &rule45},-	{11680, 7, &rule45},-	{11688, 7, &rule45},-	{11696, 7, &rule45},-	{11704, 7, &rule45},-	{11712, 7, &rule45},-	{11720, 7, &rule45},-	{11728, 7, &rule45},-	{11736, 7, &rule45},-	{11744, 32, &rule81},-	{11776, 2, &rule2},-	{11778, 1, &rule15},-	{11779, 1, &rule19},-	{11780, 1, &rule15},-	{11781, 1, &rule19},-	{11782, 3, &rule2},-	{11785, 1, &rule15},-	{11786, 1, &rule19},-	{11787, 1, &rule2},-	{11788, 1, &rule15},-	{11789, 1, &rule19},-	{11790, 9, &rule2},-	{11799, 1, &rule7},-	{11800, 2, &rule2},-	{11802, 1, &rule7},-	{11803, 1, &rule2},-	{11804, 1, &rule15},-	{11805, 1, &rule19},-	{11806, 2, &rule2},-	{11808, 1, &rule15},-	{11809, 1, &rule19},-	{11810, 1, &rule4},-	{11811, 1, &rule5},-	{11812, 1, &rule4},-	{11813, 1, &rule5},-	{11814, 1, &rule4},-	{11815, 1, &rule5},-	{11816, 1, &rule4},-	{11817, 1, &rule5},-	{11818, 5, &rule2},-	{11823, 1, &rule80},-	{11824, 1, &rule2},-	{11904, 26, &rule13},-	{11931, 89, &rule13},-	{12032, 214, &rule13},-	{12272, 12, &rule13},-	{12288, 1, &rule1},-	{12289, 3, &rule2},-	{12292, 1, &rule13},-	{12293, 1, &rule80},-	{12294, 1, &rule45},-	{12295, 1, &rule113},-	{12296, 1, &rule4},-	{12297, 1, &rule5},-	{12298, 1, &rule4},-	{12299, 1, &rule5},-	{12300, 1, &rule4},-	{12301, 1, &rule5},-	{12302, 1, &rule4},-	{12303, 1, &rule5},-	{12304, 1, &rule4},-	{12305, 1, &rule5},-	{12306, 2, &rule13},-	{12308, 1, &rule4},-	{12309, 1, &rule5},-	{12310, 1, &rule4},-	{12311, 1, &rule5},-	{12312, 1, &rule4},-	{12313, 1, &rule5},-	{12314, 1, &rule4},-	{12315, 1, &rule5},-	{12316, 1, &rule7},-	{12317, 1, &rule4},-	{12318, 2, &rule5},-	{12320, 1, &rule13},-	{12321, 9, &rule113},-	{12330, 6, &rule81},-	{12336, 1, &rule7},-	{12337, 5, &rule80},-	{12342, 2, &rule13},-	{12344, 3, &rule113},-	{12347, 1, &rule80},-	{12348, 1, &rule45},-	{12349, 1, &rule2},-	{12350, 2, &rule13},-	{12353, 86, &rule45},-	{12441, 2, &rule81},-	{12443, 2, &rule10},-	{12445, 2, &rule80},-	{12447, 1, &rule45},-	{12448, 1, &rule7},-	{12449, 90, &rule45},-	{12539, 1, &rule2},-	{12540, 3, &rule80},-	{12543, 1, &rule45},-	{12549, 41, &rule45},-	{12593, 94, &rule45},-	{12688, 2, &rule13},-	{12690, 4, &rule17},-	{12694, 10, &rule13},-	{12704, 24, &rule45},-	{12736, 36, &rule13},-	{12784, 16, &rule45},-	{12800, 31, &rule13},-	{12832, 10, &rule17},-	{12842, 26, &rule13},-	{12880, 1, &rule13},-	{12881, 15, &rule17},-	{12896, 32, &rule13},-	{12928, 10, &rule17},-	{12938, 39, &rule13},-	{12977, 15, &rule17},-	{12992, 63, &rule13},-	{13056, 256, &rule13},-	{13312, 6582, &rule45},-	{19904, 64, &rule13},-	{19968, 20932, &rule45},-	{40960, 21, &rule45},-	{40981, 1, &rule80},-	{40982, 1143, &rule45},-	{42128, 55, &rule13},-	{42240, 268, &rule45},-	{42508, 1, &rule80},-	{42509, 3, &rule2},-	{42512, 16, &rule45},-	{42528, 10, &rule8},-	{42538, 2, &rule45},-	{42560, 1, &rule21},-	{42561, 1, &rule22},-	{42562, 1, &rule21},-	{42563, 1, &rule22},-	{42564, 1, &rule21},-	{42565, 1, &rule22},-	{42566, 1, &rule21},-	{42567, 1, &rule22},-	{42568, 1, &rule21},-	{42569, 1, &rule22},-	{42570, 1, &rule21},-	{42571, 1, &rule22},-	{42572, 1, &rule21},-	{42573, 1, &rule22},-	{42574, 1, &rule21},-	{42575, 1, &rule22},-	{42576, 1, &rule21},-	{42577, 1, &rule22},-	{42578, 1, &rule21},-	{42579, 1, &rule22},-	{42580, 1, &rule21},-	{42581, 1, &rule22},-	{42582, 1, &rule21},-	{42583, 1, &rule22},-	{42584, 1, &rule21},-	{42585, 1, &rule22},-	{42586, 1, &rule21},-	{42587, 1, &rule22},-	{42588, 1, &rule21},-	{42589, 1, &rule22},-	{42590, 1, &rule21},-	{42591, 1, &rule22},-	{42594, 1, &rule21},-	{42595, 1, &rule22},-	{42596, 1, &rule21},-	{42597, 1, &rule22},-	{42598, 1, &rule21},-	{42599, 1, &rule22},-	{42600, 1, &rule21},-	{42601, 1, &rule22},-	{42602, 1, &rule21},-	{42603, 1, &rule22},-	{42604, 1, &rule21},-	{42605, 1, &rule22},-	{42606, 1, &rule45},-	{42607, 1, &rule81},-	{42608, 3, &rule106},-	{42611, 1, &rule2},-	{42620, 2, &rule81},-	{42622, 1, &rule2},-	{42623, 1, &rule80},-	{42624, 1, &rule21},-	{42625, 1, &rule22},-	{42626, 1, &rule21},-	{42627, 1, &rule22},-	{42628, 1, &rule21},-	{42629, 1, &rule22},-	{42630, 1, &rule21},-	{42631, 1, &rule22},-	{42632, 1, &rule21},-	{42633, 1, &rule22},-	{42634, 1, &rule21},-	{42635, 1, &rule22},-	{42636, 1, &rule21},-	{42637, 1, &rule22},-	{42638, 1, &rule21},-	{42639, 1, &rule22},-	{42640, 1, &rule21},-	{42641, 1, &rule22},-	{42642, 1, &rule21},-	{42643, 1, &rule22},-	{42644, 1, &rule21},-	{42645, 1, &rule22},-	{42646, 1, &rule21},-	{42647, 1, &rule22},-	{42752, 23, &rule10},-	{42775, 9, &rule80},-	{42784, 2, &rule10},-	{42786, 1, &rule21},-	{42787, 1, &rule22},-	{42788, 1, &rule21},-	{42789, 1, &rule22},-	{42790, 1, &rule21},-	{42791, 1, &rule22},-	{42792, 1, &rule21},-	{42793, 1, &rule22},-	{42794, 1, &rule21},-	{42795, 1, &rule22},-	{42796, 1, &rule21},-	{42797, 1, &rule22},-	{42798, 1, &rule21},-	{42799, 1, &rule22},-	{42800, 2, &rule14},-	{42802, 1, &rule21},-	{42803, 1, &rule22},-	{42804, 1, &rule21},-	{42805, 1, &rule22},-	{42806, 1, &rule21},-	{42807, 1, &rule22},-	{42808, 1, &rule21},-	{42809, 1, &rule22},-	{42810, 1, &rule21},-	{42811, 1, &rule22},-	{42812, 1, &rule21},-	{42813, 1, &rule22},-	{42814, 1, &rule21},-	{42815, 1, &rule22},-	{42816, 1, &rule21},-	{42817, 1, &rule22},-	{42818, 1, &rule21},-	{42819, 1, &rule22},-	{42820, 1, &rule21},-	{42821, 1, &rule22},-	{42822, 1, &rule21},-	{42823, 1, &rule22},-	{42824, 1, &rule21},-	{42825, 1, &rule22},-	{42826, 1, &rule21},-	{42827, 1, &rule22},-	{42828, 1, &rule21},-	{42829, 1, &rule22},-	{42830, 1, &rule21},-	{42831, 1, &rule22},-	{42832, 1, &rule21},-	{42833, 1, &rule22},-	{42834, 1, &rule21},-	{42835, 1, &rule22},-	{42836, 1, &rule21},-	{42837, 1, &rule22},-	{42838, 1, &rule21},-	{42839, 1, &rule22},-	{42840, 1, &rule21},-	{42841, 1, &rule22},-	{42842, 1, &rule21},-	{42843, 1, &rule22},-	{42844, 1, &rule21},-	{42845, 1, &rule22},-	{42846, 1, &rule21},-	{42847, 1, &rule22},-	{42848, 1, &rule21},-	{42849, 1, &rule22},-	{42850, 1, &rule21},-	{42851, 1, &rule22},-	{42852, 1, &rule21},-	{42853, 1, &rule22},-	{42854, 1, &rule21},-	{42855, 1, &rule22},-	{42856, 1, &rule21},-	{42857, 1, &rule22},-	{42858, 1, &rule21},-	{42859, 1, &rule22},-	{42860, 1, &rule21},-	{42861, 1, &rule22},-	{42862, 1, &rule21},-	{42863, 1, &rule22},-	{42864, 1, &rule80},-	{42865, 8, &rule14},-	{42873, 1, &rule21},-	{42874, 1, &rule22},-	{42875, 1, &rule21},-	{42876, 1, &rule22},-	{42877, 1, &rule156},-	{42878, 1, &rule21},-	{42879, 1, &rule22},-	{42880, 1, &rule21},-	{42881, 1, &rule22},-	{42882, 1, &rule21},-	{42883, 1, &rule22},-	{42884, 1, &rule21},-	{42885, 1, &rule22},-	{42886, 1, &rule21},-	{42887, 1, &rule22},-	{42888, 1, &rule80},-	{42889, 2, &rule10},-	{42891, 1, &rule21},-	{42892, 1, &rule22},-	{43003, 7, &rule45},-	{43010, 1, &rule81},-	{43011, 3, &rule45},-	{43014, 1, &rule81},-	{43015, 4, &rule45},-	{43019, 1, &rule81},-	{43020, 23, &rule45},-	{43043, 2, &rule111},-	{43045, 2, &rule81},-	{43047, 1, &rule111},-	{43048, 4, &rule13},-	{43072, 52, &rule45},-	{43124, 4, &rule2},-	{43136, 2, &rule111},-	{43138, 50, &rule45},-	{43188, 16, &rule111},-	{43204, 1, &rule81},-	{43214, 2, &rule2},-	{43216, 10, &rule8},-	{43264, 10, &rule8},-	{43274, 28, &rule45},-	{43302, 8, &rule81},-	{43310, 2, &rule2},-	{43312, 23, &rule45},-	{43335, 11, &rule81},-	{43346, 2, &rule111},-	{43359, 1, &rule2},-	{43520, 41, &rule45},-	{43561, 6, &rule81},-	{43567, 2, &rule111},-	{43569, 2, &rule81},-	{43571, 2, &rule111},-	{43573, 2, &rule81},-	{43584, 3, &rule45},-	{43587, 1, &rule81},-	{43588, 8, &rule45},-	{43596, 1, &rule81},-	{43597, 1, &rule111},-	{43600, 10, &rule8},-	{43612, 4, &rule2},-	{44032, 11172, &rule45},-	{55296, 896, &rule157},-	{56192, 128, &rule157},-	{56320, 1024, &rule157},-	{57344, 6400, &rule158},-	{63744, 302, &rule45},-	{64048, 59, &rule45},-	{64112, 106, &rule45},-	{64256, 7, &rule14},-	{64275, 5, &rule14},-	{64285, 1, &rule45},-	{64286, 1, &rule81},-	{64287, 10, &rule45},-	{64297, 1, &rule6},-	{64298, 13, &rule45},-	{64312, 5, &rule45},-	{64318, 1, &rule45},-	{64320, 2, &rule45},-	{64323, 2, &rule45},-	{64326, 108, &rule45},-	{64467, 363, &rule45},-	{64830, 1, &rule4},-	{64831, 1, &rule5},-	{64848, 64, &rule45},-	{64914, 54, &rule45},-	{65008, 12, &rule45},-	{65020, 1, &rule3},-	{65021, 1, &rule13},-	{65024, 16, &rule81},-	{65040, 7, &rule2},-	{65047, 1, &rule4},-	{65048, 1, &rule5},-	{65049, 1, &rule2},-	{65056, 7, &rule81},-	{65072, 1, &rule2},-	{65073, 2, &rule7},-	{65075, 2, &rule11},-	{65077, 1, &rule4},-	{65078, 1, &rule5},-	{65079, 1, &rule4},-	{65080, 1, &rule5},-	{65081, 1, &rule4},-	{65082, 1, &rule5},-	{65083, 1, &rule4},-	{65084, 1, &rule5},-	{65085, 1, &rule4},-	{65086, 1, &rule5},-	{65087, 1, &rule4},-	{65088, 1, &rule5},-	{65089, 1, &rule4},-	{65090, 1, &rule5},-	{65091, 1, &rule4},-	{65092, 1, &rule5},-	{65093, 2, &rule2},-	{65095, 1, &rule4},-	{65096, 1, &rule5},-	{65097, 4, &rule2},-	{65101, 3, &rule11},-	{65104, 3, &rule2},-	{65108, 4, &rule2},-	{65112, 1, &rule7},-	{65113, 1, &rule4},-	{65114, 1, &rule5},-	{65115, 1, &rule4},-	{65116, 1, &rule5},-	{65117, 1, &rule4},-	{65118, 1, &rule5},-	{65119, 3, &rule2},-	{65122, 1, &rule6},-	{65123, 1, &rule7},-	{65124, 3, &rule6},-	{65128, 1, &rule2},-	{65129, 1, &rule3},-	{65130, 2, &rule2},-	{65136, 5, &rule45},-	{65142, 135, &rule45},-	{65279, 1, &rule16},-	{65281, 3, &rule2},-	{65284, 1, &rule3},-	{65285, 3, &rule2},-	{65288, 1, &rule4},-	{65289, 1, &rule5},-	{65290, 1, &rule2},-	{65291, 1, &rule6},-	{65292, 1, &rule2},-	{65293, 1, &rule7},-	{65294, 2, &rule2},-	{65296, 10, &rule8},-	{65306, 2, &rule2},-	{65308, 3, &rule6},-	{65311, 2, &rule2},-	{65313, 26, &rule9},-	{65339, 1, &rule4},-	{65340, 1, &rule2},-	{65341, 1, &rule5},-	{65342, 1, &rule10},-	{65343, 1, &rule11},-	{65344, 1, &rule10},-	{65345, 26, &rule12},-	{65371, 1, &rule4},-	{65372, 1, &rule6},-	{65373, 1, &rule5},-	{65374, 1, &rule6},-	{65375, 1, &rule4},-	{65376, 1, &rule5},-	{65377, 1, &rule2},-	{65378, 1, &rule4},-	{65379, 1, &rule5},-	{65380, 2, &rule2},-	{65382, 10, &rule45},-	{65392, 1, &rule80},-	{65393, 45, &rule45},-	{65438, 2, &rule80},-	{65440, 31, &rule45},-	{65474, 6, &rule45},-	{65482, 6, &rule45},-	{65490, 6, &rule45},-	{65498, 3, &rule45},-	{65504, 2, &rule3},-	{65506, 1, &rule6},-	{65507, 1, &rule10},-	{65508, 1, &rule13},-	{65509, 2, &rule3},-	{65512, 1, &rule13},-	{65513, 4, &rule6},-	{65517, 2, &rule13},-	{65529, 3, &rule16},-	{65532, 2, &rule13},-	{65536, 12, &rule45},-	{65549, 26, &rule45},-	{65576, 19, &rule45},-	{65596, 2, &rule45},-	{65599, 15, &rule45},-	{65616, 14, &rule45},-	{65664, 123, &rule45},-	{65792, 2, &rule2},-	{65794, 1, &rule13},-	{65799, 45, &rule17},-	{65847, 9, &rule13},-	{65856, 53, &rule113},-	{65909, 4, &rule17},-	{65913, 17, &rule13},-	{65930, 1, &rule17},-	{65936, 12, &rule13},-	{66000, 45, &rule13},-	{66045, 1, &rule81},-	{66176, 29, &rule45},-	{66208, 49, &rule45},-	{66304, 31, &rule45},-	{66336, 4, &rule17},-	{66352, 17, &rule45},-	{66369, 1, &rule113},-	{66370, 8, &rule45},-	{66378, 1, &rule113},-	{66432, 30, &rule45},-	{66463, 1, &rule2},-	{66464, 36, &rule45},-	{66504, 8, &rule45},-	{66512, 1, &rule2},-	{66513, 5, &rule113},-	{66560, 40, &rule159},-	{66600, 40, &rule160},-	{66640, 78, &rule45},-	{66720, 10, &rule8},-	{67584, 6, &rule45},-	{67592, 1, &rule45},-	{67594, 44, &rule45},-	{67639, 2, &rule45},-	{67644, 1, &rule45},-	{67647, 1, &rule45},-	{67840, 22, &rule45},-	{67862, 4, &rule17},-	{67871, 1, &rule2},-	{67872, 26, &rule45},-	{67903, 1, &rule2},-	{68096, 1, &rule45},-	{68097, 3, &rule81},-	{68101, 2, &rule81},-	{68108, 4, &rule81},-	{68112, 4, &rule45},-	{68117, 3, &rule45},-	{68121, 27, &rule45},-	{68152, 3, &rule81},-	{68159, 1, &rule81},-	{68160, 8, &rule17},-	{68176, 9, &rule2},-	{73728, 879, &rule45},-	{74752, 99, &rule113},-	{74864, 4, &rule2},-	{118784, 246, &rule13},-	{119040, 39, &rule13},-	{119081, 60, &rule13},-	{119141, 2, &rule111},-	{119143, 3, &rule81},-	{119146, 3, &rule13},-	{119149, 6, &rule111},-	{119155, 8, &rule16},-	{119163, 8, &rule81},-	{119171, 2, &rule13},-	{119173, 7, &rule81},-	{119180, 30, &rule13},-	{119210, 4, &rule81},-	{119214, 48, &rule13},-	{119296, 66, &rule13},-	{119362, 3, &rule81},-	{119365, 1, &rule13},-	{119552, 87, &rule13},-	{119648, 18, &rule17},-	{119808, 26, &rule95},-	{119834, 26, &rule14},-	{119860, 26, &rule95},-	{119886, 7, &rule14},-	{119894, 18, &rule14},-	{119912, 26, &rule95},-	{119938, 26, &rule14},-	{119964, 1, &rule95},-	{119966, 2, &rule95},-	{119970, 1, &rule95},-	{119973, 2, &rule95},-	{119977, 4, &rule95},-	{119982, 8, &rule95},-	{119990, 4, &rule14},-	{119995, 1, &rule14},-	{119997, 7, &rule14},-	{120005, 11, &rule14},-	{120016, 26, &rule95},-	{120042, 26, &rule14},-	{120068, 2, &rule95},-	{120071, 4, &rule95},-	{120077, 8, &rule95},-	{120086, 7, &rule95},-	{120094, 26, &rule14},-	{120120, 2, &rule95},-	{120123, 4, &rule95},-	{120128, 5, &rule95},-	{120134, 1, &rule95},-	{120138, 7, &rule95},-	{120146, 26, &rule14},-	{120172, 26, &rule95},-	{120198, 26, &rule14},-	{120224, 26, &rule95},-	{120250, 26, &rule14},-	{120276, 26, &rule95},-	{120302, 26, &rule14},-	{120328, 26, &rule95},-	{120354, 26, &rule14},-	{120380, 26, &rule95},-	{120406, 26, &rule14},-	{120432, 26, &rule95},-	{120458, 28, &rule14},-	{120488, 25, &rule95},-	{120513, 1, &rule6},-	{120514, 25, &rule14},-	{120539, 1, &rule6},-	{120540, 6, &rule14},-	{120546, 25, &rule95},-	{120571, 1, &rule6},-	{120572, 25, &rule14},-	{120597, 1, &rule6},-	{120598, 6, &rule14},-	{120604, 25, &rule95},-	{120629, 1, &rule6},-	{120630, 25, &rule14},-	{120655, 1, &rule6},-	{120656, 6, &rule14},-	{120662, 25, &rule95},-	{120687, 1, &rule6},-	{120688, 25, &rule14},-	{120713, 1, &rule6},-	{120714, 6, &rule14},-	{120720, 25, &rule95},-	{120745, 1, &rule6},-	{120746, 25, &rule14},-	{120771, 1, &rule6},-	{120772, 6, &rule14},-	{120778, 1, &rule95},-	{120779, 1, &rule14},-	{120782, 50, &rule8},-	{126976, 44, &rule13},-	{127024, 100, &rule13},-	{131072, 42711, &rule45},-	{194560, 542, &rule45},-	{917505, 1, &rule16},-	{917536, 96, &rule16},-	{917760, 240, &rule81},-	{983040, 65534, &rule158},-	{1048576, 65534, &rule158}-};-static const struct _charblock_ convchars[]={-	{65, 26, &rule9},-	{97, 26, &rule12},-	{181, 1, &rule18},-	{192, 23, &rule9},-	{216, 7, &rule9},-	{224, 23, &rule12},-	{248, 7, &rule12},-	{255, 1, &rule20},-	{256, 1, &rule21},-	{257, 1, &rule22},-	{258, 1, &rule21},-	{259, 1, &rule22},-	{260, 1, &rule21},-	{261, 1, &rule22},-	{262, 1, &rule21},-	{263, 1, &rule22},-	{264, 1, &rule21},-	{265, 1, &rule22},-	{266, 1, &rule21},-	{267, 1, &rule22},-	{268, 1, &rule21},-	{269, 1, &rule22},-	{270, 1, &rule21},-	{271, 1, &rule22},-	{272, 1, &rule21},-	{273, 1, &rule22},-	{274, 1, &rule21},-	{275, 1, &rule22},-	{276, 1, &rule21},-	{277, 1, &rule22},-	{278, 1, &rule21},-	{279, 1, &rule22},-	{280, 1, &rule21},-	{281, 1, &rule22},-	{282, 1, &rule21},-	{283, 1, &rule22},-	{284, 1, &rule21},-	{285, 1, &rule22},-	{286, 1, &rule21},-	{287, 1, &rule22},-	{288, 1, &rule21},-	{289, 1, &rule22},-	{290, 1, &rule21},-	{291, 1, &rule22},-	{292, 1, &rule21},-	{293, 1, &rule22},-	{294, 1, &rule21},-	{295, 1, &rule22},-	{296, 1, &rule21},-	{297, 1, &rule22},-	{298, 1, &rule21},-	{299, 1, &rule22},-	{300, 1, &rule21},-	{301, 1, &rule22},-	{302, 1, &rule21},-	{303, 1, &rule22},-	{304, 1, &rule23},-	{305, 1, &rule24},-	{306, 1, &rule21},-	{307, 1, &rule22},-	{308, 1, &rule21},-	{309, 1, &rule22},-	{310, 1, &rule21},-	{311, 1, &rule22},-	{313, 1, &rule21},-	{314, 1, &rule22},-	{315, 1, &rule21},-	{316, 1, &rule22},-	{317, 1, &rule21},-	{318, 1, &rule22},-	{319, 1, &rule21},-	{320, 1, &rule22},-	{321, 1, &rule21},-	{322, 1, &rule22},-	{323, 1, &rule21},-	{324, 1, &rule22},-	{325, 1, &rule21},-	{326, 1, &rule22},-	{327, 1, &rule21},-	{328, 1, &rule22},-	{330, 1, &rule21},-	{331, 1, &rule22},-	{332, 1, &rule21},-	{333, 1, &rule22},-	{334, 1, &rule21},-	{335, 1, &rule22},-	{336, 1, &rule21},-	{337, 1, &rule22},-	{338, 1, &rule21},-	{339, 1, &rule22},-	{340, 1, &rule21},-	{341, 1, &rule22},-	{342, 1, &rule21},-	{343, 1, &rule22},-	{344, 1, &rule21},-	{345, 1, &rule22},-	{346, 1, &rule21},-	{347, 1, &rule22},-	{348, 1, &rule21},-	{349, 1, &rule22},-	{350, 1, &rule21},-	{351, 1, &rule22},-	{352, 1, &rule21},-	{353, 1, &rule22},-	{354, 1, &rule21},-	{355, 1, &rule22},-	{356, 1, &rule21},-	{357, 1, &rule22},-	{358, 1, &rule21},-	{359, 1, &rule22},-	{360, 1, &rule21},-	{361, 1, &rule22},-	{362, 1, &rule21},-	{363, 1, &rule22},-	{364, 1, &rule21},-	{365, 1, &rule22},-	{366, 1, &rule21},-	{367, 1, &rule22},-	{368, 1, &rule21},-	{369, 1, &rule22},-	{370, 1, &rule21},-	{371, 1, &rule22},-	{372, 1, &rule21},-	{373, 1, &rule22},-	{374, 1, &rule21},-	{375, 1, &rule22},-	{376, 1, &rule25},-	{377, 1, &rule21},-	{378, 1, &rule22},-	{379, 1, &rule21},-	{380, 1, &rule22},-	{381, 1, &rule21},-	{382, 1, &rule22},-	{383, 1, &rule26},-	{384, 1, &rule27},-	{385, 1, &rule28},-	{386, 1, &rule21},-	{387, 1, &rule22},-	{388, 1, &rule21},-	{389, 1, &rule22},-	{390, 1, &rule29},-	{391, 1, &rule21},-	{392, 1, &rule22},-	{393, 2, &rule30},-	{395, 1, &rule21},-	{396, 1, &rule22},-	{398, 1, &rule31},-	{399, 1, &rule32},-	{400, 1, &rule33},-	{401, 1, &rule21},-	{402, 1, &rule22},-	{403, 1, &rule30},-	{404, 1, &rule34},-	{405, 1, &rule35},-	{406, 1, &rule36},-	{407, 1, &rule37},-	{408, 1, &rule21},-	{409, 1, &rule22},-	{410, 1, &rule38},-	{412, 1, &rule36},-	{413, 1, &rule39},-	{414, 1, &rule40},-	{415, 1, &rule41},-	{416, 1, &rule21},-	{417, 1, &rule22},-	{418, 1, &rule21},-	{419, 1, &rule22},-	{420, 1, &rule21},-	{421, 1, &rule22},-	{422, 1, &rule42},-	{423, 1, &rule21},-	{424, 1, &rule22},-	{425, 1, &rule42},-	{428, 1, &rule21},-	{429, 1, &rule22},-	{430, 1, &rule42},-	{431, 1, &rule21},-	{432, 1, &rule22},-	{433, 2, &rule43},-	{435, 1, &rule21},-	{436, 1, &rule22},-	{437, 1, &rule21},-	{438, 1, &rule22},-	{439, 1, &rule44},-	{440, 1, &rule21},-	{441, 1, &rule22},-	{444, 1, &rule21},-	{445, 1, &rule22},-	{447, 1, &rule46},-	{452, 1, &rule47},-	{453, 1, &rule48},-	{454, 1, &rule49},-	{455, 1, &rule47},-	{456, 1, &rule48},-	{457, 1, &rule49},-	{458, 1, &rule47},-	{459, 1, &rule48},-	{460, 1, &rule49},-	{461, 1, &rule21},-	{462, 1, &rule22},-	{463, 1, &rule21},-	{464, 1, &rule22},-	{465, 1, &rule21},-	{466, 1, &rule22},-	{467, 1, &rule21},-	{468, 1, &rule22},-	{469, 1, &rule21},-	{470, 1, &rule22},-	{471, 1, &rule21},-	{472, 1, &rule22},-	{473, 1, &rule21},-	{474, 1, &rule22},-	{475, 1, &rule21},-	{476, 1, &rule22},-	{477, 1, &rule50},-	{478, 1, &rule21},-	{479, 1, &rule22},-	{480, 1, &rule21},-	{481, 1, &rule22},-	{482, 1, &rule21},-	{483, 1, &rule22},-	{484, 1, &rule21},-	{485, 1, &rule22},-	{486, 1, &rule21},-	{487, 1, &rule22},-	{488, 1, &rule21},-	{489, 1, &rule22},-	{490, 1, &rule21},-	{491, 1, &rule22},-	{492, 1, &rule21},-	{493, 1, &rule22},-	{494, 1, &rule21},-	{495, 1, &rule22},-	{497, 1, &rule47},-	{498, 1, &rule48},-	{499, 1, &rule49},-	{500, 1, &rule21},-	{501, 1, &rule22},-	{502, 1, &rule51},-	{503, 1, &rule52},-	{504, 1, &rule21},-	{505, 1, &rule22},-	{506, 1, &rule21},-	{507, 1, &rule22},-	{508, 1, &rule21},-	{509, 1, &rule22},-	{510, 1, &rule21},-	{511, 1, &rule22},-	{512, 1, &rule21},-	{513, 1, &rule22},-	{514, 1, &rule21},-	{515, 1, &rule22},-	{516, 1, &rule21},-	{517, 1, &rule22},-	{518, 1, &rule21},-	{519, 1, &rule22},-	{520, 1, &rule21},-	{521, 1, &rule22},-	{522, 1, &rule21},-	{523, 1, &rule22},-	{524, 1, &rule21},-	{525, 1, &rule22},-	{526, 1, &rule21},-	{527, 1, &rule22},-	{528, 1, &rule21},-	{529, 1, &rule22},-	{530, 1, &rule21},-	{531, 1, &rule22},-	{532, 1, &rule21},-	{533, 1, &rule22},-	{534, 1, &rule21},-	{535, 1, &rule22},-	{536, 1, &rule21},-	{537, 1, &rule22},-	{538, 1, &rule21},-	{539, 1, &rule22},-	{540, 1, &rule21},-	{541, 1, &rule22},-	{542, 1, &rule21},-	{543, 1, &rule22},-	{544, 1, &rule53},-	{546, 1, &rule21},-	{547, 1, &rule22},-	{548, 1, &rule21},-	{549, 1, &rule22},-	{550, 1, &rule21},-	{551, 1, &rule22},-	{552, 1, &rule21},-	{553, 1, &rule22},-	{554, 1, &rule21},-	{555, 1, &rule22},-	{556, 1, &rule21},-	{557, 1, &rule22},-	{558, 1, &rule21},-	{559, 1, &rule22},-	{560, 1, &rule21},-	{561, 1, &rule22},-	{562, 1, &rule21},-	{563, 1, &rule22},-	{570, 1, &rule54},-	{571, 1, &rule21},-	{572, 1, &rule22},-	{573, 1, &rule55},-	{574, 1, &rule56},-	{577, 1, &rule21},-	{578, 1, &rule22},-	{579, 1, &rule57},-	{580, 1, &rule58},-	{581, 1, &rule59},-	{582, 1, &rule21},-	{583, 1, &rule22},-	{584, 1, &rule21},-	{585, 1, &rule22},-	{586, 1, &rule21},-	{587, 1, &rule22},-	{588, 1, &rule21},-	{589, 1, &rule22},-	{590, 1, &rule21},-	{591, 1, &rule22},-	{592, 1, &rule60},-	{593, 1, &rule61},-	{595, 1, &rule62},-	{596, 1, &rule63},-	{598, 2, &rule64},-	{601, 1, &rule65},-	{603, 1, &rule66},-	{608, 1, &rule64},-	{611, 1, &rule67},-	{616, 1, &rule68},-	{617, 1, &rule69},-	{619, 1, &rule70},-	{623, 1, &rule69},-	{625, 1, &rule71},-	{626, 1, &rule72},-	{629, 1, &rule73},-	{637, 1, &rule74},-	{640, 1, &rule75},-	{643, 1, &rule75},-	{648, 1, &rule75},-	{649, 1, &rule76},-	{650, 2, &rule77},-	{652, 1, &rule78},-	{658, 1, &rule79},-	{837, 1, &rule82},-	{880, 1, &rule21},-	{881, 1, &rule22},-	{882, 1, &rule21},-	{883, 1, &rule22},-	{886, 1, &rule21},-	{887, 1, &rule22},-	{891, 3, &rule40},-	{902, 1, &rule83},-	{904, 3, &rule84},-	{908, 1, &rule85},-	{910, 2, &rule86},-	{913, 17, &rule9},-	{931, 9, &rule9},-	{940, 1, &rule87},-	{941, 3, &rule88},-	{945, 17, &rule12},-	{962, 1, &rule89},-	{963, 9, &rule12},-	{972, 1, &rule90},-	{973, 2, &rule91},-	{975, 1, &rule92},-	{976, 1, &rule93},-	{977, 1, &rule94},-	{981, 1, &rule96},-	{982, 1, &rule97},-	{983, 1, &rule98},-	{984, 1, &rule21},-	{985, 1, &rule22},-	{986, 1, &rule21},-	{987, 1, &rule22},-	{988, 1, &rule21},-	{989, 1, &rule22},-	{990, 1, &rule21},-	{991, 1, &rule22},-	{992, 1, &rule21},-	{993, 1, &rule22},-	{994, 1, &rule21},-	{995, 1, &rule22},-	{996, 1, &rule21},-	{997, 1, &rule22},-	{998, 1, &rule21},-	{999, 1, &rule22},-	{1000, 1, &rule21},-	{1001, 1, &rule22},-	{1002, 1, &rule21},-	{1003, 1, &rule22},-	{1004, 1, &rule21},-	{1005, 1, &rule22},-	{1006, 1, &rule21},-	{1007, 1, &rule22},-	{1008, 1, &rule99},-	{1009, 1, &rule100},-	{1010, 1, &rule101},-	{1012, 1, &rule102},-	{1013, 1, &rule103},-	{1015, 1, &rule21},-	{1016, 1, &rule22},-	{1017, 1, &rule104},-	{1018, 1, &rule21},-	{1019, 1, &rule22},-	{1021, 3, &rule53},-	{1024, 16, &rule105},-	{1040, 32, &rule9},-	{1072, 32, &rule12},-	{1104, 16, &rule100},-	{1120, 1, &rule21},-	{1121, 1, &rule22},-	{1122, 1, &rule21},-	{1123, 1, &rule22},-	{1124, 1, &rule21},-	{1125, 1, &rule22},-	{1126, 1, &rule21},-	{1127, 1, &rule22},-	{1128, 1, &rule21},-	{1129, 1, &rule22},-	{1130, 1, &rule21},-	{1131, 1, &rule22},-	{1132, 1, &rule21},-	{1133, 1, &rule22},-	{1134, 1, &rule21},-	{1135, 1, &rule22},-	{1136, 1, &rule21},-	{1137, 1, &rule22},-	{1138, 1, &rule21},-	{1139, 1, &rule22},-	{1140, 1, &rule21},-	{1141, 1, &rule22},-	{1142, 1, &rule21},-	{1143, 1, &rule22},-	{1144, 1, &rule21},-	{1145, 1, &rule22},-	{1146, 1, &rule21},-	{1147, 1, &rule22},-	{1148, 1, &rule21},-	{1149, 1, &rule22},-	{1150, 1, &rule21},-	{1151, 1, &rule22},-	{1152, 1, &rule21},-	{1153, 1, &rule22},-	{1162, 1, &rule21},-	{1163, 1, &rule22},-	{1164, 1, &rule21},-	{1165, 1, &rule22},-	{1166, 1, &rule21},-	{1167, 1, &rule22},-	{1168, 1, &rule21},-	{1169, 1, &rule22},-	{1170, 1, &rule21},-	{1171, 1, &rule22},-	{1172, 1, &rule21},-	{1173, 1, &rule22},-	{1174, 1, &rule21},-	{1175, 1, &rule22},-	{1176, 1, &rule21},-	{1177, 1, &rule22},-	{1178, 1, &rule21},-	{1179, 1, &rule22},-	{1180, 1, &rule21},-	{1181, 1, &rule22},-	{1182, 1, &rule21},-	{1183, 1, &rule22},-	{1184, 1, &rule21},-	{1185, 1, &rule22},-	{1186, 1, &rule21},-	{1187, 1, &rule22},-	{1188, 1, &rule21},-	{1189, 1, &rule22},-	{1190, 1, &rule21},-	{1191, 1, &rule22},-	{1192, 1, &rule21},-	{1193, 1, &rule22},-	{1194, 1, &rule21},-	{1195, 1, &rule22},-	{1196, 1, &rule21},-	{1197, 1, &rule22},-	{1198, 1, &rule21},-	{1199, 1, &rule22},-	{1200, 1, &rule21},-	{1201, 1, &rule22},-	{1202, 1, &rule21},-	{1203, 1, &rule22},-	{1204, 1, &rule21},-	{1205, 1, &rule22},-	{1206, 1, &rule21},-	{1207, 1, &rule22},-	{1208, 1, &rule21},-	{1209, 1, &rule22},-	{1210, 1, &rule21},-	{1211, 1, &rule22},-	{1212, 1, &rule21},-	{1213, 1, &rule22},-	{1214, 1, &rule21},-	{1215, 1, &rule22},-	{1216, 1, &rule107},-	{1217, 1, &rule21},-	{1218, 1, &rule22},-	{1219, 1, &rule21},-	{1220, 1, &rule22},-	{1221, 1, &rule21},-	{1222, 1, &rule22},-	{1223, 1, &rule21},-	{1224, 1, &rule22},-	{1225, 1, &rule21},-	{1226, 1, &rule22},-	{1227, 1, &rule21},-	{1228, 1, &rule22},-	{1229, 1, &rule21},-	{1230, 1, &rule22},-	{1231, 1, &rule108},-	{1232, 1, &rule21},-	{1233, 1, &rule22},-	{1234, 1, &rule21},-	{1235, 1, &rule22},-	{1236, 1, &rule21},-	{1237, 1, &rule22},-	{1238, 1, &rule21},-	{1239, 1, &rule22},-	{1240, 1, &rule21},-	{1241, 1, &rule22},-	{1242, 1, &rule21},-	{1243, 1, &rule22},-	{1244, 1, &rule21},-	{1245, 1, &rule22},-	{1246, 1, &rule21},-	{1247, 1, &rule22},-	{1248, 1, &rule21},-	{1249, 1, &rule22},-	{1250, 1, &rule21},-	{1251, 1, &rule22},-	{1252, 1, &rule21},-	{1253, 1, &rule22},-	{1254, 1, &rule21},-	{1255, 1, &rule22},-	{1256, 1, &rule21},-	{1257, 1, &rule22},-	{1258, 1, &rule21},-	{1259, 1, &rule22},-	{1260, 1, &rule21},-	{1261, 1, &rule22},-	{1262, 1, &rule21},-	{1263, 1, &rule22},-	{1264, 1, &rule21},-	{1265, 1, &rule22},-	{1266, 1, &rule21},-	{1267, 1, &rule22},-	{1268, 1, &rule21},-	{1269, 1, &rule22},-	{1270, 1, &rule21},-	{1271, 1, &rule22},-	{1272, 1, &rule21},-	{1273, 1, &rule22},-	{1274, 1, &rule21},-	{1275, 1, &rule22},-	{1276, 1, &rule21},-	{1277, 1, &rule22},-	{1278, 1, &rule21},-	{1279, 1, &rule22},-	{1280, 1, &rule21},-	{1281, 1, &rule22},-	{1282, 1, &rule21},-	{1283, 1, &rule22},-	{1284, 1, &rule21},-	{1285, 1, &rule22},-	{1286, 1, &rule21},-	{1287, 1, &rule22},-	{1288, 1, &rule21},-	{1289, 1, &rule22},-	{1290, 1, &rule21},-	{1291, 1, &rule22},-	{1292, 1, &rule21},-	{1293, 1, &rule22},-	{1294, 1, &rule21},-	{1295, 1, &rule22},-	{1296, 1, &rule21},-	{1297, 1, &rule22},-	{1298, 1, &rule21},-	{1299, 1, &rule22},-	{1300, 1, &rule21},-	{1301, 1, &rule22},-	{1302, 1, &rule21},-	{1303, 1, &rule22},-	{1304, 1, &rule21},-	{1305, 1, &rule22},-	{1306, 1, &rule21},-	{1307, 1, &rule22},-	{1308, 1, &rule21},-	{1309, 1, &rule22},-	{1310, 1, &rule21},-	{1311, 1, &rule22},-	{1312, 1, &rule21},-	{1313, 1, &rule22},-	{1314, 1, &rule21},-	{1315, 1, &rule22},-	{1329, 38, &rule109},-	{1377, 38, &rule110},-	{4256, 38, &rule112},-	{7545, 1, &rule114},-	{7549, 1, &rule115},-	{7680, 1, &rule21},-	{7681, 1, &rule22},-	{7682, 1, &rule21},-	{7683, 1, &rule22},-	{7684, 1, &rule21},-	{7685, 1, &rule22},-	{7686, 1, &rule21},-	{7687, 1, &rule22},-	{7688, 1, &rule21},-	{7689, 1, &rule22},-	{7690, 1, &rule21},-	{7691, 1, &rule22},-	{7692, 1, &rule21},-	{7693, 1, &rule22},-	{7694, 1, &rule21},-	{7695, 1, &rule22},-	{7696, 1, &rule21},-	{7697, 1, &rule22},-	{7698, 1, &rule21},-	{7699, 1, &rule22},-	{7700, 1, &rule21},-	{7701, 1, &rule22},-	{7702, 1, &rule21},-	{7703, 1, &rule22},-	{7704, 1, &rule21},-	{7705, 1, &rule22},-	{7706, 1, &rule21},-	{7707, 1, &rule22},-	{7708, 1, &rule21},-	{7709, 1, &rule22},-	{7710, 1, &rule21},-	{7711, 1, &rule22},-	{7712, 1, &rule21},-	{7713, 1, &rule22},-	{7714, 1, &rule21},-	{7715, 1, &rule22},-	{7716, 1, &rule21},-	{7717, 1, &rule22},-	{7718, 1, &rule21},-	{7719, 1, &rule22},-	{7720, 1, &rule21},-	{7721, 1, &rule22},-	{7722, 1, &rule21},-	{7723, 1, &rule22},-	{7724, 1, &rule21},-	{7725, 1, &rule22},-	{7726, 1, &rule21},-	{7727, 1, &rule22},-	{7728, 1, &rule21},-	{7729, 1, &rule22},-	{7730, 1, &rule21},-	{7731, 1, &rule22},-	{7732, 1, &rule21},-	{7733, 1, &rule22},-	{7734, 1, &rule21},-	{7735, 1, &rule22},-	{7736, 1, &rule21},-	{7737, 1, &rule22},-	{7738, 1, &rule21},-	{7739, 1, &rule22},-	{7740, 1, &rule21},-	{7741, 1, &rule22},-	{7742, 1, &rule21},-	{7743, 1, &rule22},-	{7744, 1, &rule21},-	{7745, 1, &rule22},-	{7746, 1, &rule21},-	{7747, 1, &rule22},-	{7748, 1, &rule21},-	{7749, 1, &rule22},-	{7750, 1, &rule21},-	{7751, 1, &rule22},-	{7752, 1, &rule21},-	{7753, 1, &rule22},-	{7754, 1, &rule21},-	{7755, 1, &rule22},-	{7756, 1, &rule21},-	{7757, 1, &rule22},-	{7758, 1, &rule21},-	{7759, 1, &rule22},-	{7760, 1, &rule21},-	{7761, 1, &rule22},-	{7762, 1, &rule21},-	{7763, 1, &rule22},-	{7764, 1, &rule21},-	{7765, 1, &rule22},-	{7766, 1, &rule21},-	{7767, 1, &rule22},-	{7768, 1, &rule21},-	{7769, 1, &rule22},-	{7770, 1, &rule21},-	{7771, 1, &rule22},-	{7772, 1, &rule21},-	{7773, 1, &rule22},-	{7774, 1, &rule21},-	{7775, 1, &rule22},-	{7776, 1, &rule21},-	{7777, 1, &rule22},-	{7778, 1, &rule21},-	{7779, 1, &rule22},-	{7780, 1, &rule21},-	{7781, 1, &rule22},-	{7782, 1, &rule21},-	{7783, 1, &rule22},-	{7784, 1, &rule21},-	{7785, 1, &rule22},-	{7786, 1, &rule21},-	{7787, 1, &rule22},-	{7788, 1, &rule21},-	{7789, 1, &rule22},-	{7790, 1, &rule21},-	{7791, 1, &rule22},-	{7792, 1, &rule21},-	{7793, 1, &rule22},-	{7794, 1, &rule21},-	{7795, 1, &rule22},-	{7796, 1, &rule21},-	{7797, 1, &rule22},-	{7798, 1, &rule21},-	{7799, 1, &rule22},-	{7800, 1, &rule21},-	{7801, 1, &rule22},-	{7802, 1, &rule21},-	{7803, 1, &rule22},-	{7804, 1, &rule21},-	{7805, 1, &rule22},-	{7806, 1, &rule21},-	{7807, 1, &rule22},-	{7808, 1, &rule21},-	{7809, 1, &rule22},-	{7810, 1, &rule21},-	{7811, 1, &rule22},-	{7812, 1, &rule21},-	{7813, 1, &rule22},-	{7814, 1, &rule21},-	{7815, 1, &rule22},-	{7816, 1, &rule21},-	{7817, 1, &rule22},-	{7818, 1, &rule21},-	{7819, 1, &rule22},-	{7820, 1, &rule21},-	{7821, 1, &rule22},-	{7822, 1, &rule21},-	{7823, 1, &rule22},-	{7824, 1, &rule21},-	{7825, 1, &rule22},-	{7826, 1, &rule21},-	{7827, 1, &rule22},-	{7828, 1, &rule21},-	{7829, 1, &rule22},-	{7835, 1, &rule116},-	{7838, 1, &rule117},-	{7840, 1, &rule21},-	{7841, 1, &rule22},-	{7842, 1, &rule21},-	{7843, 1, &rule22},-	{7844, 1, &rule21},-	{7845, 1, &rule22},-	{7846, 1, &rule21},-	{7847, 1, &rule22},-	{7848, 1, &rule21},-	{7849, 1, &rule22},-	{7850, 1, &rule21},-	{7851, 1, &rule22},-	{7852, 1, &rule21},-	{7853, 1, &rule22},-	{7854, 1, &rule21},-	{7855, 1, &rule22},-	{7856, 1, &rule21},-	{7857, 1, &rule22},-	{7858, 1, &rule21},-	{7859, 1, &rule22},-	{7860, 1, &rule21},-	{7861, 1, &rule22},-	{7862, 1, &rule21},-	{7863, 1, &rule22},-	{7864, 1, &rule21},-	{7865, 1, &rule22},-	{7866, 1, &rule21},-	{7867, 1, &rule22},-	{7868, 1, &rule21},-	{7869, 1, &rule22},-	{7870, 1, &rule21},-	{7871, 1, &rule22},-	{7872, 1, &rule21},-	{7873, 1, &rule22},-	{7874, 1, &rule21},-	{7875, 1, &rule22},-	{7876, 1, &rule21},-	{7877, 1, &rule22},-	{7878, 1, &rule21},-	{7879, 1, &rule22},-	{7880, 1, &rule21},-	{7881, 1, &rule22},-	{7882, 1, &rule21},-	{7883, 1, &rule22},-	{7884, 1, &rule21},-	{7885, 1, &rule22},-	{7886, 1, &rule21},-	{7887, 1, &rule22},-	{7888, 1, &rule21},-	{7889, 1, &rule22},-	{7890, 1, &rule21},-	{7891, 1, &rule22},-	{7892, 1, &rule21},-	{7893, 1, &rule22},-	{7894, 1, &rule21},-	{7895, 1, &rule22},-	{7896, 1, &rule21},-	{7897, 1, &rule22},-	{7898, 1, &rule21},-	{7899, 1, &rule22},-	{7900, 1, &rule21},-	{7901, 1, &rule22},-	{7902, 1, &rule21},-	{7903, 1, &rule22},-	{7904, 1, &rule21},-	{7905, 1, &rule22},-	{7906, 1, &rule21},-	{7907, 1, &rule22},-	{7908, 1, &rule21},-	{7909, 1, &rule22},-	{7910, 1, &rule21},-	{7911, 1, &rule22},-	{7912, 1, &rule21},-	{7913, 1, &rule22},-	{7914, 1, &rule21},-	{7915, 1, &rule22},-	{7916, 1, &rule21},-	{7917, 1, &rule22},-	{7918, 1, &rule21},-	{7919, 1, &rule22},-	{7920, 1, &rule21},-	{7921, 1, &rule22},-	{7922, 1, &rule21},-	{7923, 1, &rule22},-	{7924, 1, &rule21},-	{7925, 1, &rule22},-	{7926, 1, &rule21},-	{7927, 1, &rule22},-	{7928, 1, &rule21},-	{7929, 1, &rule22},-	{7930, 1, &rule21},-	{7931, 1, &rule22},-	{7932, 1, &rule21},-	{7933, 1, &rule22},-	{7934, 1, &rule21},-	{7935, 1, &rule22},-	{7936, 8, &rule118},-	{7944, 8, &rule119},-	{7952, 6, &rule118},-	{7960, 6, &rule119},-	{7968, 8, &rule118},-	{7976, 8, &rule119},-	{7984, 8, &rule118},-	{7992, 8, &rule119},-	{8000, 6, &rule118},-	{8008, 6, &rule119},-	{8017, 1, &rule118},-	{8019, 1, &rule118},-	{8021, 1, &rule118},-	{8023, 1, &rule118},-	{8025, 1, &rule119},-	{8027, 1, &rule119},-	{8029, 1, &rule119},-	{8031, 1, &rule119},-	{8032, 8, &rule118},-	{8040, 8, &rule119},-	{8048, 2, &rule120},-	{8050, 4, &rule121},-	{8054, 2, &rule122},-	{8056, 2, &rule123},-	{8058, 2, &rule124},-	{8060, 2, &rule125},-	{8064, 8, &rule118},-	{8072, 8, &rule126},-	{8080, 8, &rule118},-	{8088, 8, &rule126},-	{8096, 8, &rule118},-	{8104, 8, &rule126},-	{8112, 2, &rule118},-	{8115, 1, &rule127},-	{8120, 2, &rule119},-	{8122, 2, &rule128},-	{8124, 1, &rule129},-	{8126, 1, &rule130},-	{8131, 1, &rule127},-	{8136, 4, &rule131},-	{8140, 1, &rule129},-	{8144, 2, &rule118},-	{8152, 2, &rule119},-	{8154, 2, &rule132},-	{8160, 2, &rule118},-	{8165, 1, &rule101},-	{8168, 2, &rule119},-	{8170, 2, &rule133},-	{8172, 1, &rule104},-	{8179, 1, &rule127},-	{8184, 2, &rule134},-	{8186, 2, &rule135},-	{8188, 1, &rule129},-	{8486, 1, &rule138},-	{8490, 1, &rule139},-	{8491, 1, &rule140},-	{8498, 1, &rule141},-	{8526, 1, &rule142},-	{8544, 16, &rule143},-	{8560, 16, &rule144},-	{8579, 1, &rule21},-	{8580, 1, &rule22},-	{9398, 26, &rule145},-	{9424, 26, &rule146},-	{11264, 47, &rule109},-	{11312, 47, &rule110},-	{11360, 1, &rule21},-	{11361, 1, &rule22},-	{11362, 1, &rule147},-	{11363, 1, &rule148},-	{11364, 1, &rule149},-	{11365, 1, &rule150},-	{11366, 1, &rule151},-	{11367, 1, &rule21},-	{11368, 1, &rule22},-	{11369, 1, &rule21},-	{11370, 1, &rule22},-	{11371, 1, &rule21},-	{11372, 1, &rule22},-	{11373, 1, &rule152},-	{11374, 1, &rule153},-	{11375, 1, &rule154},-	{11378, 1, &rule21},-	{11379, 1, &rule22},-	{11381, 1, &rule21},-	{11382, 1, &rule22},-	{11392, 1, &rule21},-	{11393, 1, &rule22},-	{11394, 1, &rule21},-	{11395, 1, &rule22},-	{11396, 1, &rule21},-	{11397, 1, &rule22},-	{11398, 1, &rule21},-	{11399, 1, &rule22},-	{11400, 1, &rule21},-	{11401, 1, &rule22},-	{11402, 1, &rule21},-	{11403, 1, &rule22},-	{11404, 1, &rule21},-	{11405, 1, &rule22},-	{11406, 1, &rule21},-	{11407, 1, &rule22},-	{11408, 1, &rule21},-	{11409, 1, &rule22},-	{11410, 1, &rule21},-	{11411, 1, &rule22},-	{11412, 1, &rule21},-	{11413, 1, &rule22},-	{11414, 1, &rule21},-	{11415, 1, &rule22},-	{11416, 1, &rule21},-	{11417, 1, &rule22},-	{11418, 1, &rule21},-	{11419, 1, &rule22},-	{11420, 1, &rule21},-	{11421, 1, &rule22},-	{11422, 1, &rule21},-	{11423, 1, &rule22},-	{11424, 1, &rule21},-	{11425, 1, &rule22},-	{11426, 1, &rule21},-	{11427, 1, &rule22},-	{11428, 1, &rule21},-	{11429, 1, &rule22},-	{11430, 1, &rule21},-	{11431, 1, &rule22},-	{11432, 1, &rule21},-	{11433, 1, &rule22},-	{11434, 1, &rule21},-	{11435, 1, &rule22},-	{11436, 1, &rule21},-	{11437, 1, &rule22},-	{11438, 1, &rule21},-	{11439, 1, &rule22},-	{11440, 1, &rule21},-	{11441, 1, &rule22},-	{11442, 1, &rule21},-	{11443, 1, &rule22},-	{11444, 1, &rule21},-	{11445, 1, &rule22},-	{11446, 1, &rule21},-	{11447, 1, &rule22},-	{11448, 1, &rule21},-	{11449, 1, &rule22},-	{11450, 1, &rule21},-	{11451, 1, &rule22},-	{11452, 1, &rule21},-	{11453, 1, &rule22},-	{11454, 1, &rule21},-	{11455, 1, &rule22},-	{11456, 1, &rule21},-	{11457, 1, &rule22},-	{11458, 1, &rule21},-	{11459, 1, &rule22},-	{11460, 1, &rule21},-	{11461, 1, &rule22},-	{11462, 1, &rule21},-	{11463, 1, &rule22},-	{11464, 1, &rule21},-	{11465, 1, &rule22},-	{11466, 1, &rule21},-	{11467, 1, &rule22},-	{11468, 1, &rule21},-	{11469, 1, &rule22},-	{11470, 1, &rule21},-	{11471, 1, &rule22},-	{11472, 1, &rule21},-	{11473, 1, &rule22},-	{11474, 1, &rule21},-	{11475, 1, &rule22},-	{11476, 1, &rule21},-	{11477, 1, &rule22},-	{11478, 1, &rule21},-	{11479, 1, &rule22},-	{11480, 1, &rule21},-	{11481, 1, &rule22},-	{11482, 1, &rule21},-	{11483, 1, &rule22},-	{11484, 1, &rule21},-	{11485, 1, &rule22},-	{11486, 1, &rule21},-	{11487, 1, &rule22},-	{11488, 1, &rule21},-	{11489, 1, &rule22},-	{11490, 1, &rule21},-	{11491, 1, &rule22},-	{11520, 38, &rule155},-	{42560, 1, &rule21},-	{42561, 1, &rule22},-	{42562, 1, &rule21},-	{42563, 1, &rule22},-	{42564, 1, &rule21},-	{42565, 1, &rule22},-	{42566, 1, &rule21},-	{42567, 1, &rule22},-	{42568, 1, &rule21},-	{42569, 1, &rule22},-	{42570, 1, &rule21},-	{42571, 1, &rule22},-	{42572, 1, &rule21},-	{42573, 1, &rule22},-	{42574, 1, &rule21},-	{42575, 1, &rule22},-	{42576, 1, &rule21},-	{42577, 1, &rule22},-	{42578, 1, &rule21},-	{42579, 1, &rule22},-	{42580, 1, &rule21},-	{42581, 1, &rule22},-	{42582, 1, &rule21},-	{42583, 1, &rule22},-	{42584, 1, &rule21},-	{42585, 1, &rule22},-	{42586, 1, &rule21},-	{42587, 1, &rule22},-	{42588, 1, &rule21},-	{42589, 1, &rule22},-	{42590, 1, &rule21},-	{42591, 1, &rule22},-	{42594, 1, &rule21},-	{42595, 1, &rule22},-	{42596, 1, &rule21},-	{42597, 1, &rule22},-	{42598, 1, &rule21},-	{42599, 1, &rule22},-	{42600, 1, &rule21},-	{42601, 1, &rule22},-	{42602, 1, &rule21},-	{42603, 1, &rule22},-	{42604, 1, &rule21},-	{42605, 1, &rule22},-	{42624, 1, &rule21},-	{42625, 1, &rule22},-	{42626, 1, &rule21},-	{42627, 1, &rule22},-	{42628, 1, &rule21},-	{42629, 1, &rule22},-	{42630, 1, &rule21},-	{42631, 1, &rule22},-	{42632, 1, &rule21},-	{42633, 1, &rule22},-	{42634, 1, &rule21},-	{42635, 1, &rule22},-	{42636, 1, &rule21},-	{42637, 1, &rule22},-	{42638, 1, &rule21},-	{42639, 1, &rule22},-	{42640, 1, &rule21},-	{42641, 1, &rule22},-	{42642, 1, &rule21},-	{42643, 1, &rule22},-	{42644, 1, &rule21},-	{42645, 1, &rule22},-	{42646, 1, &rule21},-	{42647, 1, &rule22},-	{42786, 1, &rule21},-	{42787, 1, &rule22},-	{42788, 1, &rule21},-	{42789, 1, &rule22},-	{42790, 1, &rule21},-	{42791, 1, &rule22},-	{42792, 1, &rule21},-	{42793, 1, &rule22},-	{42794, 1, &rule21},-	{42795, 1, &rule22},-	{42796, 1, &rule21},-	{42797, 1, &rule22},-	{42798, 1, &rule21},-	{42799, 1, &rule22},-	{42802, 1, &rule21},-	{42803, 1, &rule22},-	{42804, 1, &rule21},-	{42805, 1, &rule22},-	{42806, 1, &rule21},-	{42807, 1, &rule22},-	{42808, 1, &rule21},-	{42809, 1, &rule22},-	{42810, 1, &rule21},-	{42811, 1, &rule22},-	{42812, 1, &rule21},-	{42813, 1, &rule22},-	{42814, 1, &rule21},-	{42815, 1, &rule22},-	{42816, 1, &rule21},-	{42817, 1, &rule22},-	{42818, 1, &rule21},-	{42819, 1, &rule22},-	{42820, 1, &rule21},-	{42821, 1, &rule22},-	{42822, 1, &rule21},-	{42823, 1, &rule22},-	{42824, 1, &rule21},-	{42825, 1, &rule22},-	{42826, 1, &rule21},-	{42827, 1, &rule22},-	{42828, 1, &rule21},-	{42829, 1, &rule22},-	{42830, 1, &rule21},-	{42831, 1, &rule22},-	{42832, 1, &rule21},-	{42833, 1, &rule22},-	{42834, 1, &rule21},-	{42835, 1, &rule22},-	{42836, 1, &rule21},-	{42837, 1, &rule22},-	{42838, 1, &rule21},-	{42839, 1, &rule22},-	{42840, 1, &rule21},-	{42841, 1, &rule22},-	{42842, 1, &rule21},-	{42843, 1, &rule22},-	{42844, 1, &rule21},-	{42845, 1, &rule22},-	{42846, 1, &rule21},-	{42847, 1, &rule22},-	{42848, 1, &rule21},-	{42849, 1, &rule22},-	{42850, 1, &rule21},-	{42851, 1, &rule22},-	{42852, 1, &rule21},-	{42853, 1, &rule22},-	{42854, 1, &rule21},-	{42855, 1, &rule22},-	{42856, 1, &rule21},-	{42857, 1, &rule22},-	{42858, 1, &rule21},-	{42859, 1, &rule22},-	{42860, 1, &rule21},-	{42861, 1, &rule22},-	{42862, 1, &rule21},-	{42863, 1, &rule22},-	{42873, 1, &rule21},-	{42874, 1, &rule22},-	{42875, 1, &rule21},-	{42876, 1, &rule22},-	{42877, 1, &rule156},-	{42878, 1, &rule21},-	{42879, 1, &rule22},-	{42880, 1, &rule21},-	{42881, 1, &rule22},-	{42882, 1, &rule21},-	{42883, 1, &rule22},-	{42884, 1, &rule21},-	{42885, 1, &rule22},-	{42886, 1, &rule21},-	{42887, 1, &rule22},-	{42891, 1, &rule21},-	{42892, 1, &rule22},-	{65313, 26, &rule9},-	{65345, 26, &rule12},-	{66560, 40, &rule159},-	{66600, 40, &rule160}+Generated by ubconfc at Mon Feb  7 20:26:56 CET 2011+-------------------------------------------------------------------------*/++#include "WCsubst.h"++/* Unicode general categories, listed in the same order as in the Unicode+ * standard -- this must be the same order as in GHC.Unicode.+ */++enum {+    NUMCAT_LU,  /* Letter, Uppercase */+    NUMCAT_LL,  /* Letter, Lowercase */+    NUMCAT_LT,  /* Letter, Titlecase */+    NUMCAT_LM,  /* Letter, Modifier */+    NUMCAT_LO,  /* Letter, Other */+    NUMCAT_MN,  /* Mark, Non-Spacing */+    NUMCAT_MC,  /* Mark, Spacing Combining */+    NUMCAT_ME,  /* Mark, Enclosing */+    NUMCAT_ND,  /* Number, Decimal */+    NUMCAT_NL,  /* Number, Letter */+    NUMCAT_NO,  /* Number, Other */+    NUMCAT_PC,  /* Punctuation, Connector */+    NUMCAT_PD,  /* Punctuation, Dash */+    NUMCAT_PS,  /* Punctuation, Open */+    NUMCAT_PE,  /* Punctuation, Close */+    NUMCAT_PI,  /* Punctuation, Initial quote */+    NUMCAT_PF,  /* Punctuation, Final quote */+    NUMCAT_PO,  /* Punctuation, Other */+    NUMCAT_SM,  /* Symbol, Math */+    NUMCAT_SC,  /* Symbol, Currency */+    NUMCAT_SK,  /* Symbol, Modifier */+    NUMCAT_SO,  /* Symbol, Other */+    NUMCAT_ZS,  /* Separator, Space */+    NUMCAT_ZL,  /* Separator, Line */+    NUMCAT_ZP,  /* Separator, Paragraph */+    NUMCAT_CC,  /* Other, Control */+    NUMCAT_CF,  /* Other, Format */+    NUMCAT_CS,  /* Other, Surrogate */+    NUMCAT_CO,  /* Other, Private Use */+    NUMCAT_CN   /* Other, Not Assigned */+};++struct _convrule_ +{ +	unsigned int category;+	unsigned int catnumber;+	int possible;+	int updist;+	int lowdist; +	int titledist;+};++struct _charblock_ +{ +	int start;+	int length;+	const struct _convrule_ *rule;+};++#define GENCAT_LO 262144+#define GENCAT_PC 2048+#define GENCAT_PD 128+#define GENCAT_MN 2097152+#define GENCAT_PE 32+#define GENCAT_NL 16777216+#define GENCAT_PF 131072+#define GENCAT_LT 524288+#define GENCAT_NO 65536+#define GENCAT_LU 512+#define GENCAT_PI 16384+#define GENCAT_SC 8+#define GENCAT_PO 4+#define GENCAT_PS 16+#define GENCAT_SK 1024+#define GENCAT_SM 64+#define GENCAT_SO 8192+#define GENCAT_CC 1+#define GENCAT_CF 32768+#define GENCAT_CO 268435456+#define GENCAT_ZL 33554432+#define GENCAT_CS 134217728+#define GENCAT_ZP 67108864+#define GENCAT_ZS 2+#define GENCAT_MC 8388608+#define GENCAT_ME 4194304+#define GENCAT_ND 256+#define GENCAT_LL 4096+#define GENCAT_LM 1048576+#define MAX_UNI_CHAR 1114109+#define NUM_BLOCKS 2783+#define NUM_CONVBLOCKS 1230+#define NUM_SPACEBLOCKS 8+#define NUM_LAT1BLOCKS 63+#define NUM_RULES 167+static const struct _convrule_ rule160={GENCAT_LL, NUMCAT_LL, 1, -7264, 0, -7264};+static const struct _convrule_ rule36={GENCAT_LU, NUMCAT_LU, 1, 0, 211, 0};+static const struct _convrule_ rule25={GENCAT_LU, NUMCAT_LU, 1, 0, -121, 0};+static const struct _convrule_ rule18={GENCAT_LL, NUMCAT_LL, 1, 743, 0, 743};+static const struct _convrule_ rule108={GENCAT_LU, NUMCAT_LU, 1, 0, 80, 0};+static const struct _convrule_ rule50={GENCAT_LL, NUMCAT_LL, 1, -79, 0, -79};+static const struct _convrule_ rule106={GENCAT_LL, NUMCAT_LL, 1, -96, 0, -96};+static const struct _convrule_ rule79={GENCAT_LL, NUMCAT_LL, 1, -69, 0, -69};+static const struct _convrule_ rule126={GENCAT_LL, NUMCAT_LL, 1, 128, 0, 128};+static const struct _convrule_ rule119={GENCAT_LL, NUMCAT_LL, 1, -59, 0, -59};+static const struct _convrule_ rule102={GENCAT_LL, NUMCAT_LL, 1, -86, 0, -86};+static const struct _convrule_ rule38={GENCAT_LL, NUMCAT_LL, 1, 163, 0, 163};+static const struct _convrule_ rule113={GENCAT_LL, NUMCAT_LL, 1, -48, 0, -48};+static const struct _convrule_ rule133={GENCAT_LL, NUMCAT_LL, 1, -7205, 0, -7205};+static const struct _convrule_ rule128={GENCAT_LL, NUMCAT_LL, 1, 126, 0, 126};+static const struct _convrule_ rule97={GENCAT_LL, NUMCAT_LL, 1, -57, 0, -57};+static const struct _convrule_ rule161={GENCAT_LU, NUMCAT_LU, 1, 0, -35332, 0};+static const struct _convrule_ rule136={GENCAT_LU, NUMCAT_LU, 1, 0, -112, 0};+static const struct _convrule_ rule99={GENCAT_LL, NUMCAT_LL, 1, -47, 0, -47};+static const struct _convrule_ rule90={GENCAT_LL, NUMCAT_LL, 1, -38, 0, -38};+static const struct _convrule_ rule32={GENCAT_LU, NUMCAT_LU, 1, 0, 202, 0};+static const struct _convrule_ rule145={GENCAT_LL, NUMCAT_LL, 1, -28, 0, -28};+static const struct _convrule_ rule93={GENCAT_LL, NUMCAT_LL, 1, -64, 0, -64};+static const struct _convrule_ rule91={GENCAT_LL, NUMCAT_LL, 1, -37, 0, -37};+static const struct _convrule_ rule60={GENCAT_LU, NUMCAT_LU, 1, 0, 71, 0};+static const struct _convrule_ rule100={GENCAT_LL, NUMCAT_LL, 1, -54, 0, -54};+static const struct _convrule_ rule94={GENCAT_LL, NUMCAT_LL, 1, -63, 0, -63};+static const struct _convrule_ rule35={GENCAT_LL, NUMCAT_LL, 1, 97, 0, 97};+static const struct _convrule_ rule149={GENCAT_SO, NUMCAT_SO, 1, -26, 0, -26};+static const struct _convrule_ rule103={GENCAT_LL, NUMCAT_LL, 1, -80, 0, -80};+static const struct _convrule_ rule96={GENCAT_LL, NUMCAT_LL, 1, -62, 0, -62};+static const struct _convrule_ rule81={GENCAT_LL, NUMCAT_LL, 1, -71, 0, -71};+static const struct _convrule_ rule9={GENCAT_LU, NUMCAT_LU, 1, 0, 32, 0};+static const struct _convrule_ rule147={GENCAT_NL, NUMCAT_NL, 1, -16, 0, -16};+static const struct _convrule_ rule143={GENCAT_LU, NUMCAT_LU, 1, 0, -8262, 0};+static const struct _convrule_ rule127={GENCAT_LL, NUMCAT_LL, 1, 112, 0, 112};+static const struct _convrule_ rule124={GENCAT_LL, NUMCAT_LL, 1, 86, 0, 86};+static const struct _convrule_ rule40={GENCAT_LL, NUMCAT_LL, 1, 130, 0, 130};+static const struct _convrule_ rule20={GENCAT_LL, NUMCAT_LL, 1, 121, 0, 121};+static const struct _convrule_ rule158={GENCAT_LU, NUMCAT_LU, 1, 0, -10782, 0};+static const struct _convrule_ rule111={GENCAT_LL, NUMCAT_LL, 1, -15, 0, -15};+static const struct _convrule_ rule12={GENCAT_LL, NUMCAT_LL, 1, -32, 0, -32};+static const struct _convrule_ rule85={GENCAT_MN, NUMCAT_MN, 1, 84, 0, 84};+static const struct _convrule_ rule166={GENCAT_LL, NUMCAT_LL, 1, -40, 0, -40};+static const struct _convrule_ rule125={GENCAT_LL, NUMCAT_LL, 1, 100, 0, 100};+static const struct _convrule_ rule123={GENCAT_LL, NUMCAT_LL, 1, 74, 0, 74};+static const struct _convrule_ rule92={GENCAT_LL, NUMCAT_LL, 1, -31, 0, -31};+static const struct _convrule_ rule56={GENCAT_LU, NUMCAT_LU, 1, 0, 10792, 0};+static const struct _convrule_ rule46={GENCAT_LL, NUMCAT_LL, 1, 56, 0, 56};+static const struct _convrule_ rule33={GENCAT_LU, NUMCAT_LU, 1, 0, 203, 0};+static const struct _convrule_ rule150={GENCAT_LU, NUMCAT_LU, 1, 0, -10743, 0};+static const struct _convrule_ rule39={GENCAT_LU, NUMCAT_LU, 1, 0, 213, 0};+static const struct _convrule_ rule57={GENCAT_LL, NUMCAT_LL, 1, 10815, 0, 10815};+static const struct _convrule_ rule157={GENCAT_LU, NUMCAT_LU, 1, 0, -10783, 0};+static const struct _convrule_ rule55={GENCAT_LU, NUMCAT_LU, 1, 0, -163, 0};+static const struct _convrule_ rule151={GENCAT_LU, NUMCAT_LU, 1, 0, -3814, 0};+static const struct _convrule_ rule142={GENCAT_LU, NUMCAT_LU, 1, 0, -8383, 0};+static const struct _convrule_ rule101={GENCAT_LL, NUMCAT_LL, 1, -8, 0, -8};+static const struct _convrule_ rule89={GENCAT_LU, NUMCAT_LU, 1, 0, 63, 0};+static const struct _convrule_ rule41={GENCAT_LU, NUMCAT_LU, 1, 0, 214, 0};+static const struct _convrule_ rule118={GENCAT_LL, NUMCAT_LL, 1, 3814, 0, 3814};+static const struct _convrule_ rule26={GENCAT_LL, NUMCAT_LL, 1, -300, 0, -300};+static const struct _convrule_ rule159={GENCAT_LU, NUMCAT_LU, 1, 0, -10815, 0};+static const struct _convrule_ rule115={GENCAT_LU, NUMCAT_LU, 1, 0, 7264, 0};+static const struct _convrule_ rule22={GENCAT_LL, NUMCAT_LL, 1, -1, 0, -1};+static const struct _convrule_ rule120={GENCAT_LU, NUMCAT_LU, 1, 0, -7615, 0};+static const struct _convrule_ rule49={GENCAT_LL, NUMCAT_LL, 1, -2, 0, -1};+static const struct _convrule_ rule131={GENCAT_LU, NUMCAT_LU, 1, 0, -74, 0};+static const struct _convrule_ rule88={GENCAT_LU, NUMCAT_LU, 1, 0, 64, 0};+static const struct _convrule_ rule30={GENCAT_LU, NUMCAT_LU, 1, 0, 205, 0};+static const struct _convrule_ rule117={GENCAT_LL, NUMCAT_LL, 1, 35332, 0, 35332};+static const struct _convrule_ rule110={GENCAT_LU, NUMCAT_LU, 1, 0, 15, 0};+static const struct _convrule_ rule130={GENCAT_LL, NUMCAT_LL, 1, 9, 0, 9};+static const struct _convrule_ rule121={GENCAT_LL, NUMCAT_LL, 1, 8, 0, 8};+static const struct _convrule_ rule95={GENCAT_LU, NUMCAT_LU, 1, 0, 8, 0};+static const struct _convrule_ rule54={GENCAT_LU, NUMCAT_LU, 1, 0, 10795, 0};+static const struct _convrule_ rule29={GENCAT_LU, NUMCAT_LU, 1, 0, 206, 0};+static const struct _convrule_ rule138={GENCAT_LU, NUMCAT_LU, 1, 0, -126, 0};+static const struct _convrule_ rule104={GENCAT_LL, NUMCAT_LL, 1, 7, 0, 7};+static const struct _convrule_ rule58={GENCAT_LU, NUMCAT_LU, 1, 0, -195, 0};+static const struct _convrule_ rule146={GENCAT_NL, NUMCAT_NL, 1, 0, 16, 0};+static const struct _convrule_ rule148={GENCAT_SO, NUMCAT_SO, 1, 0, 26, 0};+static const struct _convrule_ rule70={GENCAT_LL, NUMCAT_LL, 1, 42280, 0, 42280};+static const struct _convrule_ rule107={GENCAT_LU, NUMCAT_LU, 1, 0, -7, 0};+static const struct _convrule_ rule52={GENCAT_LU, NUMCAT_LU, 1, 0, -56, 0};+static const struct _convrule_ rule153={GENCAT_LL, NUMCAT_LL, 1, -10795, 0, -10795};+static const struct _convrule_ rule152={GENCAT_LU, NUMCAT_LU, 1, 0, -10727, 0};+static const struct _convrule_ rule141={GENCAT_LU, NUMCAT_LU, 1, 0, -7517, 0};+static const struct _convrule_ rule34={GENCAT_LU, NUMCAT_LU, 1, 0, 207, 0};+static const struct _convrule_ rule164={GENCAT_CO, NUMCAT_CO, 0, 0, 0, 0};+static const struct _convrule_ rule84={GENCAT_MN, NUMCAT_MN, 0, 0, 0, 0};+static const struct _convrule_ rule16={GENCAT_CF, NUMCAT_CF, 0, 0, 0, 0};+static const struct _convrule_ rule45={GENCAT_LO, NUMCAT_LO, 0, 0, 0, 0};+static const struct _convrule_ rule13={GENCAT_SO, NUMCAT_SO, 0, 0, 0, 0};+static const struct _convrule_ rule17={GENCAT_NO, NUMCAT_NO, 0, 0, 0, 0};+static const struct _convrule_ rule8={GENCAT_ND, NUMCAT_ND, 0, 0, 0, 0};+static const struct _convrule_ rule14={GENCAT_LL, NUMCAT_LL, 0, 0, 0, 0};+static const struct _convrule_ rule98={GENCAT_LU, NUMCAT_LU, 0, 0, 0, 0};+static const struct _convrule_ rule6={GENCAT_SM, NUMCAT_SM, 0, 0, 0, 0};+static const struct _convrule_ rule114={GENCAT_MC, NUMCAT_MC, 0, 0, 0, 0};+static const struct _convrule_ rule2={GENCAT_PO, NUMCAT_PO, 0, 0, 0, 0};+static const struct _convrule_ rule116={GENCAT_NL, NUMCAT_NL, 0, 0, 0, 0};+static const struct _convrule_ rule3={GENCAT_SC, NUMCAT_SC, 0, 0, 0, 0};+static const struct _convrule_ rule10={GENCAT_SK, NUMCAT_SK, 0, 0, 0, 0};+static const struct _convrule_ rule83={GENCAT_LM, NUMCAT_LM, 0, 0, 0, 0};+static const struct _convrule_ rule5={GENCAT_PE, NUMCAT_PE, 0, 0, 0, 0};+static const struct _convrule_ rule4={GENCAT_PS, NUMCAT_PS, 0, 0, 0, 0};+static const struct _convrule_ rule11={GENCAT_PC, NUMCAT_PC, 0, 0, 0, 0};+static const struct _convrule_ rule7={GENCAT_PD, NUMCAT_PD, 0, 0, 0, 0};+static const struct _convrule_ rule163={GENCAT_CS, NUMCAT_CS, 0, 0, 0, 0};+static const struct _convrule_ rule109={GENCAT_ME, NUMCAT_ME, 0, 0, 0, 0};+static const struct _convrule_ rule1={GENCAT_ZS, NUMCAT_ZS, 0, 0, 0, 0};+static const struct _convrule_ rule19={GENCAT_PF, NUMCAT_PF, 0, 0, 0, 0};+static const struct _convrule_ rule15={GENCAT_PI, NUMCAT_PI, 0, 0, 0, 0};+static const struct _convrule_ rule140={GENCAT_ZP, NUMCAT_ZP, 0, 0, 0, 0};+static const struct _convrule_ rule139={GENCAT_ZL, NUMCAT_ZL, 0, 0, 0, 0};+static const struct _convrule_ rule134={GENCAT_LU, NUMCAT_LU, 1, 0, -86, 0};+static const struct _convrule_ rule43={GENCAT_LU, NUMCAT_LU, 1, 0, 217, 0};+static const struct _convrule_ rule0={GENCAT_CC, NUMCAT_CC, 0, 0, 0, 0};+static const struct _convrule_ rule154={GENCAT_LL, NUMCAT_LL, 1, -10792, 0, -10792};+static const struct _convrule_ rule74={GENCAT_LL, NUMCAT_LL, 1, 10749, 0, 10749};+static const struct _convrule_ rule87={GENCAT_LU, NUMCAT_LU, 1, 0, 37, 0};+static const struct _convrule_ rule61={GENCAT_LL, NUMCAT_LL, 1, 10783, 0, 10783};+static const struct _convrule_ rule122={GENCAT_LU, NUMCAT_LU, 1, 0, -8, 0};+static const struct _convrule_ rule129={GENCAT_LT, NUMCAT_LT, 1, 0, -8, 0};+static const struct _convrule_ rule63={GENCAT_LL, NUMCAT_LL, 1, 10782, 0, 10782};+static const struct _convrule_ rule82={GENCAT_LL, NUMCAT_LL, 1, -219, 0, -219};+static const struct _convrule_ rule77={GENCAT_LL, NUMCAT_LL, 1, 10727, 0, 10727};+static const struct _convrule_ rule78={GENCAT_LL, NUMCAT_LL, 1, -218, 0, -218};+static const struct _convrule_ rule71={GENCAT_LL, NUMCAT_LL, 1, -209, 0, -209};+static const struct _convrule_ rule62={GENCAT_LL, NUMCAT_LL, 1, 10780, 0, 10780};+static const struct _convrule_ rule48={GENCAT_LT, NUMCAT_LT, 1, -1, 1, 0};+static const struct _convrule_ rule21={GENCAT_LU, NUMCAT_LU, 1, 0, 1, 0};+static const struct _convrule_ rule137={GENCAT_LU, NUMCAT_LU, 1, 0, -128, 0};+static const struct _convrule_ rule80={GENCAT_LL, NUMCAT_LL, 1, -217, 0, -217};+static const struct _convrule_ rule73={GENCAT_LL, NUMCAT_LL, 1, 10743, 0, 10743};+static const struct _convrule_ rule42={GENCAT_LU, NUMCAT_LU, 1, 0, 218, 0};+static const struct _convrule_ rule69={GENCAT_LL, NUMCAT_LL, 1, -207, 0, -207};+static const struct _convrule_ rule51={GENCAT_LU, NUMCAT_LU, 1, 0, -97, 0};+static const struct _convrule_ rule144={GENCAT_LU, NUMCAT_LU, 1, 0, 28, 0};+static const struct _convrule_ rule65={GENCAT_LL, NUMCAT_LL, 1, -206, 0, -206};+static const struct _convrule_ rule86={GENCAT_LU, NUMCAT_LU, 1, 0, 38, 0};+static const struct _convrule_ rule76={GENCAT_LL, NUMCAT_LL, 1, -214, 0, -214};+static const struct _convrule_ rule66={GENCAT_LL, NUMCAT_LL, 1, -205, 0, -205};+static const struct _convrule_ rule24={GENCAT_LL, NUMCAT_LL, 1, -232, 0, -232};+static const struct _convrule_ rule112={GENCAT_LU, NUMCAT_LU, 1, 0, 48, 0};+static const struct _convrule_ rule132={GENCAT_LT, NUMCAT_LT, 1, 0, -9, 0};+static const struct _convrule_ rule75={GENCAT_LL, NUMCAT_LL, 1, -213, 0, -213};+static const struct _convrule_ rule68={GENCAT_LL, NUMCAT_LL, 1, -203, 0, -203};+static const struct _convrule_ rule135={GENCAT_LU, NUMCAT_LU, 1, 0, -100, 0};+static const struct _convrule_ rule72={GENCAT_LL, NUMCAT_LL, 1, -211, 0, -211};+static const struct _convrule_ rule67={GENCAT_LL, NUMCAT_LL, 1, -202, 0, -202};+static const struct _convrule_ rule47={GENCAT_LU, NUMCAT_LU, 1, 0, 2, 1};+static const struct _convrule_ rule37={GENCAT_LU, NUMCAT_LU, 1, 0, 209, 0};+static const struct _convrule_ rule156={GENCAT_LU, NUMCAT_LU, 1, 0, -10749, 0};+static const struct _convrule_ rule64={GENCAT_LL, NUMCAT_LL, 1, -210, 0, -210};+static const struct _convrule_ rule44={GENCAT_LU, NUMCAT_LU, 1, 0, 219, 0};+static const struct _convrule_ rule28={GENCAT_LU, NUMCAT_LU, 1, 0, 210, 0};+static const struct _convrule_ rule53={GENCAT_LU, NUMCAT_LU, 1, 0, -130, 0};+static const struct _convrule_ rule165={GENCAT_LU, NUMCAT_LU, 1, 0, 40, 0};+static const struct _convrule_ rule162={GENCAT_LU, NUMCAT_LU, 1, 0, -42280, 0};+static const struct _convrule_ rule155={GENCAT_LU, NUMCAT_LU, 1, 0, -10780, 0};+static const struct _convrule_ rule105={GENCAT_LU, NUMCAT_LU, 1, 0, -60, 0};+static const struct _convrule_ rule59={GENCAT_LU, NUMCAT_LU, 1, 0, 69, 0};+static const struct _convrule_ rule31={GENCAT_LU, NUMCAT_LU, 1, 0, 79, 0};+static const struct _convrule_ rule27={GENCAT_LL, NUMCAT_LL, 1, 195, 0, 195};+static const struct _convrule_ rule23={GENCAT_LU, NUMCAT_LU, 1, 0, -199, 0};+static const struct _charblock_ allchars[]={+	{0, 32, &rule0},+	{32, 1, &rule1},+	{33, 3, &rule2},+	{36, 1, &rule3},+	{37, 3, &rule2},+	{40, 1, &rule4},+	{41, 1, &rule5},+	{42, 1, &rule2},+	{43, 1, &rule6},+	{44, 1, &rule2},+	{45, 1, &rule7},+	{46, 2, &rule2},+	{48, 10, &rule8},+	{58, 2, &rule2},+	{60, 3, &rule6},+	{63, 2, &rule2},+	{65, 26, &rule9},+	{91, 1, &rule4},+	{92, 1, &rule2},+	{93, 1, &rule5},+	{94, 1, &rule10},+	{95, 1, &rule11},+	{96, 1, &rule10},+	{97, 26, &rule12},+	{123, 1, &rule4},+	{124, 1, &rule6},+	{125, 1, &rule5},+	{126, 1, &rule6},+	{127, 33, &rule0},+	{160, 1, &rule1},+	{161, 1, &rule2},+	{162, 4, &rule3},+	{166, 2, &rule13},+	{168, 1, &rule10},+	{169, 1, &rule13},+	{170, 1, &rule14},+	{171, 1, &rule15},+	{172, 1, &rule6},+	{173, 1, &rule16},+	{174, 1, &rule13},+	{175, 1, &rule10},+	{176, 1, &rule13},+	{177, 1, &rule6},+	{178, 2, &rule17},+	{180, 1, &rule10},+	{181, 1, &rule18},+	{182, 1, &rule13},+	{183, 1, &rule2},+	{184, 1, &rule10},+	{185, 1, &rule17},+	{186, 1, &rule14},+	{187, 1, &rule19},+	{188, 3, &rule17},+	{191, 1, &rule2},+	{192, 23, &rule9},+	{215, 1, &rule6},+	{216, 7, &rule9},+	{223, 1, &rule14},+	{224, 23, &rule12},+	{247, 1, &rule6},+	{248, 7, &rule12},+	{255, 1, &rule20},+	{256, 1, &rule21},+	{257, 1, &rule22},+	{258, 1, &rule21},+	{259, 1, &rule22},+	{260, 1, &rule21},+	{261, 1, &rule22},+	{262, 1, &rule21},+	{263, 1, &rule22},+	{264, 1, &rule21},+	{265, 1, &rule22},+	{266, 1, &rule21},+	{267, 1, &rule22},+	{268, 1, &rule21},+	{269, 1, &rule22},+	{270, 1, &rule21},+	{271, 1, &rule22},+	{272, 1, &rule21},+	{273, 1, &rule22},+	{274, 1, &rule21},+	{275, 1, &rule22},+	{276, 1, &rule21},+	{277, 1, &rule22},+	{278, 1, &rule21},+	{279, 1, &rule22},+	{280, 1, &rule21},+	{281, 1, &rule22},+	{282, 1, &rule21},+	{283, 1, &rule22},+	{284, 1, &rule21},+	{285, 1, &rule22},+	{286, 1, &rule21},+	{287, 1, &rule22},+	{288, 1, &rule21},+	{289, 1, &rule22},+	{290, 1, &rule21},+	{291, 1, &rule22},+	{292, 1, &rule21},+	{293, 1, &rule22},+	{294, 1, &rule21},+	{295, 1, &rule22},+	{296, 1, &rule21},+	{297, 1, &rule22},+	{298, 1, &rule21},+	{299, 1, &rule22},+	{300, 1, &rule21},+	{301, 1, &rule22},+	{302, 1, &rule21},+	{303, 1, &rule22},+	{304, 1, &rule23},+	{305, 1, &rule24},+	{306, 1, &rule21},+	{307, 1, &rule22},+	{308, 1, &rule21},+	{309, 1, &rule22},+	{310, 1, &rule21},+	{311, 1, &rule22},+	{312, 1, &rule14},+	{313, 1, &rule21},+	{314, 1, &rule22},+	{315, 1, &rule21},+	{316, 1, &rule22},+	{317, 1, &rule21},+	{318, 1, &rule22},+	{319, 1, &rule21},+	{320, 1, &rule22},+	{321, 1, &rule21},+	{322, 1, &rule22},+	{323, 1, &rule21},+	{324, 1, &rule22},+	{325, 1, &rule21},+	{326, 1, &rule22},+	{327, 1, &rule21},+	{328, 1, &rule22},+	{329, 1, &rule14},+	{330, 1, &rule21},+	{331, 1, &rule22},+	{332, 1, &rule21},+	{333, 1, &rule22},+	{334, 1, &rule21},+	{335, 1, &rule22},+	{336, 1, &rule21},+	{337, 1, &rule22},+	{338, 1, &rule21},+	{339, 1, &rule22},+	{340, 1, &rule21},+	{341, 1, &rule22},+	{342, 1, &rule21},+	{343, 1, &rule22},+	{344, 1, &rule21},+	{345, 1, &rule22},+	{346, 1, &rule21},+	{347, 1, &rule22},+	{348, 1, &rule21},+	{349, 1, &rule22},+	{350, 1, &rule21},+	{351, 1, &rule22},+	{352, 1, &rule21},+	{353, 1, &rule22},+	{354, 1, &rule21},+	{355, 1, &rule22},+	{356, 1, &rule21},+	{357, 1, &rule22},+	{358, 1, &rule21},+	{359, 1, &rule22},+	{360, 1, &rule21},+	{361, 1, &rule22},+	{362, 1, &rule21},+	{363, 1, &rule22},+	{364, 1, &rule21},+	{365, 1, &rule22},+	{366, 1, &rule21},+	{367, 1, &rule22},+	{368, 1, &rule21},+	{369, 1, &rule22},+	{370, 1, &rule21},+	{371, 1, &rule22},+	{372, 1, &rule21},+	{373, 1, &rule22},+	{374, 1, &rule21},+	{375, 1, &rule22},+	{376, 1, &rule25},+	{377, 1, &rule21},+	{378, 1, &rule22},+	{379, 1, &rule21},+	{380, 1, &rule22},+	{381, 1, &rule21},+	{382, 1, &rule22},+	{383, 1, &rule26},+	{384, 1, &rule27},+	{385, 1, &rule28},+	{386, 1, &rule21},+	{387, 1, &rule22},+	{388, 1, &rule21},+	{389, 1, &rule22},+	{390, 1, &rule29},+	{391, 1, &rule21},+	{392, 1, &rule22},+	{393, 2, &rule30},+	{395, 1, &rule21},+	{396, 1, &rule22},+	{397, 1, &rule14},+	{398, 1, &rule31},+	{399, 1, &rule32},+	{400, 1, &rule33},+	{401, 1, &rule21},+	{402, 1, &rule22},+	{403, 1, &rule30},+	{404, 1, &rule34},+	{405, 1, &rule35},+	{406, 1, &rule36},+	{407, 1, &rule37},+	{408, 1, &rule21},+	{409, 1, &rule22},+	{410, 1, &rule38},+	{411, 1, &rule14},+	{412, 1, &rule36},+	{413, 1, &rule39},+	{414, 1, &rule40},+	{415, 1, &rule41},+	{416, 1, &rule21},+	{417, 1, &rule22},+	{418, 1, &rule21},+	{419, 1, &rule22},+	{420, 1, &rule21},+	{421, 1, &rule22},+	{422, 1, &rule42},+	{423, 1, &rule21},+	{424, 1, &rule22},+	{425, 1, &rule42},+	{426, 2, &rule14},+	{428, 1, &rule21},+	{429, 1, &rule22},+	{430, 1, &rule42},+	{431, 1, &rule21},+	{432, 1, &rule22},+	{433, 2, &rule43},+	{435, 1, &rule21},+	{436, 1, &rule22},+	{437, 1, &rule21},+	{438, 1, &rule22},+	{439, 1, &rule44},+	{440, 1, &rule21},+	{441, 1, &rule22},+	{442, 1, &rule14},+	{443, 1, &rule45},+	{444, 1, &rule21},+	{445, 1, &rule22},+	{446, 1, &rule14},+	{447, 1, &rule46},+	{448, 4, &rule45},+	{452, 1, &rule47},+	{453, 1, &rule48},+	{454, 1, &rule49},+	{455, 1, &rule47},+	{456, 1, &rule48},+	{457, 1, &rule49},+	{458, 1, &rule47},+	{459, 1, &rule48},+	{460, 1, &rule49},+	{461, 1, &rule21},+	{462, 1, &rule22},+	{463, 1, &rule21},+	{464, 1, &rule22},+	{465, 1, &rule21},+	{466, 1, &rule22},+	{467, 1, &rule21},+	{468, 1, &rule22},+	{469, 1, &rule21},+	{470, 1, &rule22},+	{471, 1, &rule21},+	{472, 1, &rule22},+	{473, 1, &rule21},+	{474, 1, &rule22},+	{475, 1, &rule21},+	{476, 1, &rule22},+	{477, 1, &rule50},+	{478, 1, &rule21},+	{479, 1, &rule22},+	{480, 1, &rule21},+	{481, 1, &rule22},+	{482, 1, &rule21},+	{483, 1, &rule22},+	{484, 1, &rule21},+	{485, 1, &rule22},+	{486, 1, &rule21},+	{487, 1, &rule22},+	{488, 1, &rule21},+	{489, 1, &rule22},+	{490, 1, &rule21},+	{491, 1, &rule22},+	{492, 1, &rule21},+	{493, 1, &rule22},+	{494, 1, &rule21},+	{495, 1, &rule22},+	{496, 1, &rule14},+	{497, 1, &rule47},+	{498, 1, &rule48},+	{499, 1, &rule49},+	{500, 1, &rule21},+	{501, 1, &rule22},+	{502, 1, &rule51},+	{503, 1, &rule52},+	{504, 1, &rule21},+	{505, 1, &rule22},+	{506, 1, &rule21},+	{507, 1, &rule22},+	{508, 1, &rule21},+	{509, 1, &rule22},+	{510, 1, &rule21},+	{511, 1, &rule22},+	{512, 1, &rule21},+	{513, 1, &rule22},+	{514, 1, &rule21},+	{515, 1, &rule22},+	{516, 1, &rule21},+	{517, 1, &rule22},+	{518, 1, &rule21},+	{519, 1, &rule22},+	{520, 1, &rule21},+	{521, 1, &rule22},+	{522, 1, &rule21},+	{523, 1, &rule22},+	{524, 1, &rule21},+	{525, 1, &rule22},+	{526, 1, &rule21},+	{527, 1, &rule22},+	{528, 1, &rule21},+	{529, 1, &rule22},+	{530, 1, &rule21},+	{531, 1, &rule22},+	{532, 1, &rule21},+	{533, 1, &rule22},+	{534, 1, &rule21},+	{535, 1, &rule22},+	{536, 1, &rule21},+	{537, 1, &rule22},+	{538, 1, &rule21},+	{539, 1, &rule22},+	{540, 1, &rule21},+	{541, 1, &rule22},+	{542, 1, &rule21},+	{543, 1, &rule22},+	{544, 1, &rule53},+	{545, 1, &rule14},+	{546, 1, &rule21},+	{547, 1, &rule22},+	{548, 1, &rule21},+	{549, 1, &rule22},+	{550, 1, &rule21},+	{551, 1, &rule22},+	{552, 1, &rule21},+	{553, 1, &rule22},+	{554, 1, &rule21},+	{555, 1, &rule22},+	{556, 1, &rule21},+	{557, 1, &rule22},+	{558, 1, &rule21},+	{559, 1, &rule22},+	{560, 1, &rule21},+	{561, 1, &rule22},+	{562, 1, &rule21},+	{563, 1, &rule22},+	{564, 6, &rule14},+	{570, 1, &rule54},+	{571, 1, &rule21},+	{572, 1, &rule22},+	{573, 1, &rule55},+	{574, 1, &rule56},+	{575, 2, &rule57},+	{577, 1, &rule21},+	{578, 1, &rule22},+	{579, 1, &rule58},+	{580, 1, &rule59},+	{581, 1, &rule60},+	{582, 1, &rule21},+	{583, 1, &rule22},+	{584, 1, &rule21},+	{585, 1, &rule22},+	{586, 1, &rule21},+	{587, 1, &rule22},+	{588, 1, &rule21},+	{589, 1, &rule22},+	{590, 1, &rule21},+	{591, 1, &rule22},+	{592, 1, &rule61},+	{593, 1, &rule62},+	{594, 1, &rule63},+	{595, 1, &rule64},+	{596, 1, &rule65},+	{597, 1, &rule14},+	{598, 2, &rule66},+	{600, 1, &rule14},+	{601, 1, &rule67},+	{602, 1, &rule14},+	{603, 1, &rule68},+	{604, 4, &rule14},+	{608, 1, &rule66},+	{609, 2, &rule14},+	{611, 1, &rule69},+	{612, 1, &rule14},+	{613, 1, &rule70},+	{614, 2, &rule14},+	{616, 1, &rule71},+	{617, 1, &rule72},+	{618, 1, &rule14},+	{619, 1, &rule73},+	{620, 3, &rule14},+	{623, 1, &rule72},+	{624, 1, &rule14},+	{625, 1, &rule74},+	{626, 1, &rule75},+	{627, 2, &rule14},+	{629, 1, &rule76},+	{630, 7, &rule14},+	{637, 1, &rule77},+	{638, 2, &rule14},+	{640, 1, &rule78},+	{641, 2, &rule14},+	{643, 1, &rule78},+	{644, 4, &rule14},+	{648, 1, &rule78},+	{649, 1, &rule79},+	{650, 2, &rule80},+	{652, 1, &rule81},+	{653, 5, &rule14},+	{658, 1, &rule82},+	{659, 1, &rule14},+	{660, 1, &rule45},+	{661, 27, &rule14},+	{688, 18, &rule83},+	{706, 4, &rule10},+	{710, 12, &rule83},+	{722, 14, &rule10},+	{736, 5, &rule83},+	{741, 7, &rule10},+	{748, 1, &rule83},+	{749, 1, &rule10},+	{750, 1, &rule83},+	{751, 17, &rule10},+	{768, 69, &rule84},+	{837, 1, &rule85},+	{838, 42, &rule84},+	{880, 1, &rule21},+	{881, 1, &rule22},+	{882, 1, &rule21},+	{883, 1, &rule22},+	{884, 1, &rule83},+	{885, 1, &rule10},+	{886, 1, &rule21},+	{887, 1, &rule22},+	{890, 1, &rule83},+	{891, 3, &rule40},+	{894, 1, &rule2},+	{900, 2, &rule10},+	{902, 1, &rule86},+	{903, 1, &rule2},+	{904, 3, &rule87},+	{908, 1, &rule88},+	{910, 2, &rule89},+	{912, 1, &rule14},+	{913, 17, &rule9},+	{931, 9, &rule9},+	{940, 1, &rule90},+	{941, 3, &rule91},+	{944, 1, &rule14},+	{945, 17, &rule12},+	{962, 1, &rule92},+	{963, 9, &rule12},+	{972, 1, &rule93},+	{973, 2, &rule94},+	{975, 1, &rule95},+	{976, 1, &rule96},+	{977, 1, &rule97},+	{978, 3, &rule98},+	{981, 1, &rule99},+	{982, 1, &rule100},+	{983, 1, &rule101},+	{984, 1, &rule21},+	{985, 1, &rule22},+	{986, 1, &rule21},+	{987, 1, &rule22},+	{988, 1, &rule21},+	{989, 1, &rule22},+	{990, 1, &rule21},+	{991, 1, &rule22},+	{992, 1, &rule21},+	{993, 1, &rule22},+	{994, 1, &rule21},+	{995, 1, &rule22},+	{996, 1, &rule21},+	{997, 1, &rule22},+	{998, 1, &rule21},+	{999, 1, &rule22},+	{1000, 1, &rule21},+	{1001, 1, &rule22},+	{1002, 1, &rule21},+	{1003, 1, &rule22},+	{1004, 1, &rule21},+	{1005, 1, &rule22},+	{1006, 1, &rule21},+	{1007, 1, &rule22},+	{1008, 1, &rule102},+	{1009, 1, &rule103},+	{1010, 1, &rule104},+	{1011, 1, &rule14},+	{1012, 1, &rule105},+	{1013, 1, &rule106},+	{1014, 1, &rule6},+	{1015, 1, &rule21},+	{1016, 1, &rule22},+	{1017, 1, &rule107},+	{1018, 1, &rule21},+	{1019, 1, &rule22},+	{1020, 1, &rule14},+	{1021, 3, &rule53},+	{1024, 16, &rule108},+	{1040, 32, &rule9},+	{1072, 32, &rule12},+	{1104, 16, &rule103},+	{1120, 1, &rule21},+	{1121, 1, &rule22},+	{1122, 1, &rule21},+	{1123, 1, &rule22},+	{1124, 1, &rule21},+	{1125, 1, &rule22},+	{1126, 1, &rule21},+	{1127, 1, &rule22},+	{1128, 1, &rule21},+	{1129, 1, &rule22},+	{1130, 1, &rule21},+	{1131, 1, &rule22},+	{1132, 1, &rule21},+	{1133, 1, &rule22},+	{1134, 1, &rule21},+	{1135, 1, &rule22},+	{1136, 1, &rule21},+	{1137, 1, &rule22},+	{1138, 1, &rule21},+	{1139, 1, &rule22},+	{1140, 1, &rule21},+	{1141, 1, &rule22},+	{1142, 1, &rule21},+	{1143, 1, &rule22},+	{1144, 1, &rule21},+	{1145, 1, &rule22},+	{1146, 1, &rule21},+	{1147, 1, &rule22},+	{1148, 1, &rule21},+	{1149, 1, &rule22},+	{1150, 1, &rule21},+	{1151, 1, &rule22},+	{1152, 1, &rule21},+	{1153, 1, &rule22},+	{1154, 1, &rule13},+	{1155, 5, &rule84},+	{1160, 2, &rule109},+	{1162, 1, &rule21},+	{1163, 1, &rule22},+	{1164, 1, &rule21},+	{1165, 1, &rule22},+	{1166, 1, &rule21},+	{1167, 1, &rule22},+	{1168, 1, &rule21},+	{1169, 1, &rule22},+	{1170, 1, &rule21},+	{1171, 1, &rule22},+	{1172, 1, &rule21},+	{1173, 1, &rule22},+	{1174, 1, &rule21},+	{1175, 1, &rule22},+	{1176, 1, &rule21},+	{1177, 1, &rule22},+	{1178, 1, &rule21},+	{1179, 1, &rule22},+	{1180, 1, &rule21},+	{1181, 1, &rule22},+	{1182, 1, &rule21},+	{1183, 1, &rule22},+	{1184, 1, &rule21},+	{1185, 1, &rule22},+	{1186, 1, &rule21},+	{1187, 1, &rule22},+	{1188, 1, &rule21},+	{1189, 1, &rule22},+	{1190, 1, &rule21},+	{1191, 1, &rule22},+	{1192, 1, &rule21},+	{1193, 1, &rule22},+	{1194, 1, &rule21},+	{1195, 1, &rule22},+	{1196, 1, &rule21},+	{1197, 1, &rule22},+	{1198, 1, &rule21},+	{1199, 1, &rule22},+	{1200, 1, &rule21},+	{1201, 1, &rule22},+	{1202, 1, &rule21},+	{1203, 1, &rule22},+	{1204, 1, &rule21},+	{1205, 1, &rule22},+	{1206, 1, &rule21},+	{1207, 1, &rule22},+	{1208, 1, &rule21},+	{1209, 1, &rule22},+	{1210, 1, &rule21},+	{1211, 1, &rule22},+	{1212, 1, &rule21},+	{1213, 1, &rule22},+	{1214, 1, &rule21},+	{1215, 1, &rule22},+	{1216, 1, &rule110},+	{1217, 1, &rule21},+	{1218, 1, &rule22},+	{1219, 1, &rule21},+	{1220, 1, &rule22},+	{1221, 1, &rule21},+	{1222, 1, &rule22},+	{1223, 1, &rule21},+	{1224, 1, &rule22},+	{1225, 1, &rule21},+	{1226, 1, &rule22},+	{1227, 1, &rule21},+	{1228, 1, &rule22},+	{1229, 1, &rule21},+	{1230, 1, &rule22},+	{1231, 1, &rule111},+	{1232, 1, &rule21},+	{1233, 1, &rule22},+	{1234, 1, &rule21},+	{1235, 1, &rule22},+	{1236, 1, &rule21},+	{1237, 1, &rule22},+	{1238, 1, &rule21},+	{1239, 1, &rule22},+	{1240, 1, &rule21},+	{1241, 1, &rule22},+	{1242, 1, &rule21},+	{1243, 1, &rule22},+	{1244, 1, &rule21},+	{1245, 1, &rule22},+	{1246, 1, &rule21},+	{1247, 1, &rule22},+	{1248, 1, &rule21},+	{1249, 1, &rule22},+	{1250, 1, &rule21},+	{1251, 1, &rule22},+	{1252, 1, &rule21},+	{1253, 1, &rule22},+	{1254, 1, &rule21},+	{1255, 1, &rule22},+	{1256, 1, &rule21},+	{1257, 1, &rule22},+	{1258, 1, &rule21},+	{1259, 1, &rule22},+	{1260, 1, &rule21},+	{1261, 1, &rule22},+	{1262, 1, &rule21},+	{1263, 1, &rule22},+	{1264, 1, &rule21},+	{1265, 1, &rule22},+	{1266, 1, &rule21},+	{1267, 1, &rule22},+	{1268, 1, &rule21},+	{1269, 1, &rule22},+	{1270, 1, &rule21},+	{1271, 1, &rule22},+	{1272, 1, &rule21},+	{1273, 1, &rule22},+	{1274, 1, &rule21},+	{1275, 1, &rule22},+	{1276, 1, &rule21},+	{1277, 1, &rule22},+	{1278, 1, &rule21},+	{1279, 1, &rule22},+	{1280, 1, &rule21},+	{1281, 1, &rule22},+	{1282, 1, &rule21},+	{1283, 1, &rule22},+	{1284, 1, &rule21},+	{1285, 1, &rule22},+	{1286, 1, &rule21},+	{1287, 1, &rule22},+	{1288, 1, &rule21},+	{1289, 1, &rule22},+	{1290, 1, &rule21},+	{1291, 1, &rule22},+	{1292, 1, &rule21},+	{1293, 1, &rule22},+	{1294, 1, &rule21},+	{1295, 1, &rule22},+	{1296, 1, &rule21},+	{1297, 1, &rule22},+	{1298, 1, &rule21},+	{1299, 1, &rule22},+	{1300, 1, &rule21},+	{1301, 1, &rule22},+	{1302, 1, &rule21},+	{1303, 1, &rule22},+	{1304, 1, &rule21},+	{1305, 1, &rule22},+	{1306, 1, &rule21},+	{1307, 1, &rule22},+	{1308, 1, &rule21},+	{1309, 1, &rule22},+	{1310, 1, &rule21},+	{1311, 1, &rule22},+	{1312, 1, &rule21},+	{1313, 1, &rule22},+	{1314, 1, &rule21},+	{1315, 1, &rule22},+	{1316, 1, &rule21},+	{1317, 1, &rule22},+	{1318, 1, &rule21},+	{1319, 1, &rule22},+	{1329, 38, &rule112},+	{1369, 1, &rule83},+	{1370, 6, &rule2},+	{1377, 38, &rule113},+	{1415, 1, &rule14},+	{1417, 1, &rule2},+	{1418, 1, &rule7},+	{1425, 45, &rule84},+	{1470, 1, &rule7},+	{1471, 1, &rule84},+	{1472, 1, &rule2},+	{1473, 2, &rule84},+	{1475, 1, &rule2},+	{1476, 2, &rule84},+	{1478, 1, &rule2},+	{1479, 1, &rule84},+	{1488, 27, &rule45},+	{1520, 3, &rule45},+	{1523, 2, &rule2},+	{1536, 4, &rule16},+	{1542, 3, &rule6},+	{1545, 2, &rule2},+	{1547, 1, &rule3},+	{1548, 2, &rule2},+	{1550, 2, &rule13},+	{1552, 11, &rule84},+	{1563, 1, &rule2},+	{1566, 2, &rule2},+	{1568, 32, &rule45},+	{1600, 1, &rule83},+	{1601, 10, &rule45},+	{1611, 21, &rule84},+	{1632, 10, &rule8},+	{1642, 4, &rule2},+	{1646, 2, &rule45},+	{1648, 1, &rule84},+	{1649, 99, &rule45},+	{1748, 1, &rule2},+	{1749, 1, &rule45},+	{1750, 7, &rule84},+	{1757, 1, &rule16},+	{1758, 1, &rule13},+	{1759, 6, &rule84},+	{1765, 2, &rule83},+	{1767, 2, &rule84},+	{1769, 1, &rule13},+	{1770, 4, &rule84},+	{1774, 2, &rule45},+	{1776, 10, &rule8},+	{1786, 3, &rule45},+	{1789, 2, &rule13},+	{1791, 1, &rule45},+	{1792, 14, &rule2},+	{1807, 1, &rule16},+	{1808, 1, &rule45},+	{1809, 1, &rule84},+	{1810, 30, &rule45},+	{1840, 27, &rule84},+	{1869, 89, &rule45},+	{1958, 11, &rule84},+	{1969, 1, &rule45},+	{1984, 10, &rule8},+	{1994, 33, &rule45},+	{2027, 9, &rule84},+	{2036, 2, &rule83},+	{2038, 1, &rule13},+	{2039, 3, &rule2},+	{2042, 1, &rule83},+	{2048, 22, &rule45},+	{2070, 4, &rule84},+	{2074, 1, &rule83},+	{2075, 9, &rule84},+	{2084, 1, &rule83},+	{2085, 3, &rule84},+	{2088, 1, &rule83},+	{2089, 5, &rule84},+	{2096, 15, &rule2},+	{2112, 25, &rule45},+	{2137, 3, &rule84},+	{2142, 1, &rule2},+	{2304, 3, &rule84},+	{2307, 1, &rule114},+	{2308, 54, &rule45},+	{2362, 1, &rule84},+	{2363, 1, &rule114},+	{2364, 1, &rule84},+	{2365, 1, &rule45},+	{2366, 3, &rule114},+	{2369, 8, &rule84},+	{2377, 4, &rule114},+	{2381, 1, &rule84},+	{2382, 2, &rule114},+	{2384, 1, &rule45},+	{2385, 7, &rule84},+	{2392, 10, &rule45},+	{2402, 2, &rule84},+	{2404, 2, &rule2},+	{2406, 10, &rule8},+	{2416, 1, &rule2},+	{2417, 1, &rule83},+	{2418, 6, &rule45},+	{2425, 7, &rule45},+	{2433, 1, &rule84},+	{2434, 2, &rule114},+	{2437, 8, &rule45},+	{2447, 2, &rule45},+	{2451, 22, &rule45},+	{2474, 7, &rule45},+	{2482, 1, &rule45},+	{2486, 4, &rule45},+	{2492, 1, &rule84},+	{2493, 1, &rule45},+	{2494, 3, &rule114},+	{2497, 4, &rule84},+	{2503, 2, &rule114},+	{2507, 2, &rule114},+	{2509, 1, &rule84},+	{2510, 1, &rule45},+	{2519, 1, &rule114},+	{2524, 2, &rule45},+	{2527, 3, &rule45},+	{2530, 2, &rule84},+	{2534, 10, &rule8},+	{2544, 2, &rule45},+	{2546, 2, &rule3},+	{2548, 6, &rule17},+	{2554, 1, &rule13},+	{2555, 1, &rule3},+	{2561, 2, &rule84},+	{2563, 1, &rule114},+	{2565, 6, &rule45},+	{2575, 2, &rule45},+	{2579, 22, &rule45},+	{2602, 7, &rule45},+	{2610, 2, &rule45},+	{2613, 2, &rule45},+	{2616, 2, &rule45},+	{2620, 1, &rule84},+	{2622, 3, &rule114},+	{2625, 2, &rule84},+	{2631, 2, &rule84},+	{2635, 3, &rule84},+	{2641, 1, &rule84},+	{2649, 4, &rule45},+	{2654, 1, &rule45},+	{2662, 10, &rule8},+	{2672, 2, &rule84},+	{2674, 3, &rule45},+	{2677, 1, &rule84},+	{2689, 2, &rule84},+	{2691, 1, &rule114},+	{2693, 9, &rule45},+	{2703, 3, &rule45},+	{2707, 22, &rule45},+	{2730, 7, &rule45},+	{2738, 2, &rule45},+	{2741, 5, &rule45},+	{2748, 1, &rule84},+	{2749, 1, &rule45},+	{2750, 3, &rule114},+	{2753, 5, &rule84},+	{2759, 2, &rule84},+	{2761, 1, &rule114},+	{2763, 2, &rule114},+	{2765, 1, &rule84},+	{2768, 1, &rule45},+	{2784, 2, &rule45},+	{2786, 2, &rule84},+	{2790, 10, &rule8},+	{2801, 1, &rule3},+	{2817, 1, &rule84},+	{2818, 2, &rule114},+	{2821, 8, &rule45},+	{2831, 2, &rule45},+	{2835, 22, &rule45},+	{2858, 7, &rule45},+	{2866, 2, &rule45},+	{2869, 5, &rule45},+	{2876, 1, &rule84},+	{2877, 1, &rule45},+	{2878, 1, &rule114},+	{2879, 1, &rule84},+	{2880, 1, &rule114},+	{2881, 4, &rule84},+	{2887, 2, &rule114},+	{2891, 2, &rule114},+	{2893, 1, &rule84},+	{2902, 1, &rule84},+	{2903, 1, &rule114},+	{2908, 2, &rule45},+	{2911, 3, &rule45},+	{2914, 2, &rule84},+	{2918, 10, &rule8},+	{2928, 1, &rule13},+	{2929, 1, &rule45},+	{2930, 6, &rule17},+	{2946, 1, &rule84},+	{2947, 1, &rule45},+	{2949, 6, &rule45},+	{2958, 3, &rule45},+	{2962, 4, &rule45},+	{2969, 2, &rule45},+	{2972, 1, &rule45},+	{2974, 2, &rule45},+	{2979, 2, &rule45},+	{2984, 3, &rule45},+	{2990, 12, &rule45},+	{3006, 2, &rule114},+	{3008, 1, &rule84},+	{3009, 2, &rule114},+	{3014, 3, &rule114},+	{3018, 3, &rule114},+	{3021, 1, &rule84},+	{3024, 1, &rule45},+	{3031, 1, &rule114},+	{3046, 10, &rule8},+	{3056, 3, &rule17},+	{3059, 6, &rule13},+	{3065, 1, &rule3},+	{3066, 1, &rule13},+	{3073, 3, &rule114},+	{3077, 8, &rule45},+	{3086, 3, &rule45},+	{3090, 23, &rule45},+	{3114, 10, &rule45},+	{3125, 5, &rule45},+	{3133, 1, &rule45},+	{3134, 3, &rule84},+	{3137, 4, &rule114},+	{3142, 3, &rule84},+	{3146, 4, &rule84},+	{3157, 2, &rule84},+	{3160, 2, &rule45},+	{3168, 2, &rule45},+	{3170, 2, &rule84},+	{3174, 10, &rule8},+	{3192, 7, &rule17},+	{3199, 1, &rule13},+	{3202, 2, &rule114},+	{3205, 8, &rule45},+	{3214, 3, &rule45},+	{3218, 23, &rule45},+	{3242, 10, &rule45},+	{3253, 5, &rule45},+	{3260, 1, &rule84},+	{3261, 1, &rule45},+	{3262, 1, &rule114},+	{3263, 1, &rule84},+	{3264, 5, &rule114},+	{3270, 1, &rule84},+	{3271, 2, &rule114},+	{3274, 2, &rule114},+	{3276, 2, &rule84},+	{3285, 2, &rule114},+	{3294, 1, &rule45},+	{3296, 2, &rule45},+	{3298, 2, &rule84},+	{3302, 10, &rule8},+	{3313, 2, &rule45},+	{3330, 2, &rule114},+	{3333, 8, &rule45},+	{3342, 3, &rule45},+	{3346, 41, &rule45},+	{3389, 1, &rule45},+	{3390, 3, &rule114},+	{3393, 4, &rule84},+	{3398, 3, &rule114},+	{3402, 3, &rule114},+	{3405, 1, &rule84},+	{3406, 1, &rule45},+	{3415, 1, &rule114},+	{3424, 2, &rule45},+	{3426, 2, &rule84},+	{3430, 10, &rule8},+	{3440, 6, &rule17},+	{3449, 1, &rule13},+	{3450, 6, &rule45},+	{3458, 2, &rule114},+	{3461, 18, &rule45},+	{3482, 24, &rule45},+	{3507, 9, &rule45},+	{3517, 1, &rule45},+	{3520, 7, &rule45},+	{3530, 1, &rule84},+	{3535, 3, &rule114},+	{3538, 3, &rule84},+	{3542, 1, &rule84},+	{3544, 8, &rule114},+	{3570, 2, &rule114},+	{3572, 1, &rule2},+	{3585, 48, &rule45},+	{3633, 1, &rule84},+	{3634, 2, &rule45},+	{3636, 7, &rule84},+	{3647, 1, &rule3},+	{3648, 6, &rule45},+	{3654, 1, &rule83},+	{3655, 8, &rule84},+	{3663, 1, &rule2},+	{3664, 10, &rule8},+	{3674, 2, &rule2},+	{3713, 2, &rule45},+	{3716, 1, &rule45},+	{3719, 2, &rule45},+	{3722, 1, &rule45},+	{3725, 1, &rule45},+	{3732, 4, &rule45},+	{3737, 7, &rule45},+	{3745, 3, &rule45},+	{3749, 1, &rule45},+	{3751, 1, &rule45},+	{3754, 2, &rule45},+	{3757, 4, &rule45},+	{3761, 1, &rule84},+	{3762, 2, &rule45},+	{3764, 6, &rule84},+	{3771, 2, &rule84},+	{3773, 1, &rule45},+	{3776, 5, &rule45},+	{3782, 1, &rule83},+	{3784, 6, &rule84},+	{3792, 10, &rule8},+	{3804, 2, &rule45},+	{3840, 1, &rule45},+	{3841, 3, &rule13},+	{3844, 15, &rule2},+	{3859, 5, &rule13},+	{3864, 2, &rule84},+	{3866, 6, &rule13},+	{3872, 10, &rule8},+	{3882, 10, &rule17},+	{3892, 1, &rule13},+	{3893, 1, &rule84},+	{3894, 1, &rule13},+	{3895, 1, &rule84},+	{3896, 1, &rule13},+	{3897, 1, &rule84},+	{3898, 1, &rule4},+	{3899, 1, &rule5},+	{3900, 1, &rule4},+	{3901, 1, &rule5},+	{3902, 2, &rule114},+	{3904, 8, &rule45},+	{3913, 36, &rule45},+	{3953, 14, &rule84},+	{3967, 1, &rule114},+	{3968, 5, &rule84},+	{3973, 1, &rule2},+	{3974, 2, &rule84},+	{3976, 5, &rule45},+	{3981, 11, &rule84},+	{3993, 36, &rule84},+	{4030, 8, &rule13},+	{4038, 1, &rule84},+	{4039, 6, &rule13},+	{4046, 2, &rule13},+	{4048, 5, &rule2},+	{4053, 4, &rule13},+	{4057, 2, &rule2},+	{4096, 43, &rule45},+	{4139, 2, &rule114},+	{4141, 4, &rule84},+	{4145, 1, &rule114},+	{4146, 6, &rule84},+	{4152, 1, &rule114},+	{4153, 2, &rule84},+	{4155, 2, &rule114},+	{4157, 2, &rule84},+	{4159, 1, &rule45},+	{4160, 10, &rule8},+	{4170, 6, &rule2},+	{4176, 6, &rule45},+	{4182, 2, &rule114},+	{4184, 2, &rule84},+	{4186, 4, &rule45},+	{4190, 3, &rule84},+	{4193, 1, &rule45},+	{4194, 3, &rule114},+	{4197, 2, &rule45},+	{4199, 7, &rule114},+	{4206, 3, &rule45},+	{4209, 4, &rule84},+	{4213, 13, &rule45},+	{4226, 1, &rule84},+	{4227, 2, &rule114},+	{4229, 2, &rule84},+	{4231, 6, &rule114},+	{4237, 1, &rule84},+	{4238, 1, &rule45},+	{4239, 1, &rule114},+	{4240, 10, &rule8},+	{4250, 3, &rule114},+	{4253, 1, &rule84},+	{4254, 2, &rule13},+	{4256, 38, &rule115},+	{4304, 43, &rule45},+	{4347, 1, &rule2},+	{4348, 1, &rule83},+	{4352, 329, &rule45},+	{4682, 4, &rule45},+	{4688, 7, &rule45},+	{4696, 1, &rule45},+	{4698, 4, &rule45},+	{4704, 41, &rule45},+	{4746, 4, &rule45},+	{4752, 33, &rule45},+	{4786, 4, &rule45},+	{4792, 7, &rule45},+	{4800, 1, &rule45},+	{4802, 4, &rule45},+	{4808, 15, &rule45},+	{4824, 57, &rule45},+	{4882, 4, &rule45},+	{4888, 67, &rule45},+	{4957, 3, &rule84},+	{4960, 1, &rule13},+	{4961, 8, &rule2},+	{4969, 20, &rule17},+	{4992, 16, &rule45},+	{5008, 10, &rule13},+	{5024, 85, &rule45},+	{5120, 1, &rule7},+	{5121, 620, &rule45},+	{5741, 2, &rule2},+	{5743, 17, &rule45},+	{5760, 1, &rule1},+	{5761, 26, &rule45},+	{5787, 1, &rule4},+	{5788, 1, &rule5},+	{5792, 75, &rule45},+	{5867, 3, &rule2},+	{5870, 3, &rule116},+	{5888, 13, &rule45},+	{5902, 4, &rule45},+	{5906, 3, &rule84},+	{5920, 18, &rule45},+	{5938, 3, &rule84},+	{5941, 2, &rule2},+	{5952, 18, &rule45},+	{5970, 2, &rule84},+	{5984, 13, &rule45},+	{5998, 3, &rule45},+	{6002, 2, &rule84},+	{6016, 52, &rule45},+	{6068, 2, &rule16},+	{6070, 1, &rule114},+	{6071, 7, &rule84},+	{6078, 8, &rule114},+	{6086, 1, &rule84},+	{6087, 2, &rule114},+	{6089, 11, &rule84},+	{6100, 3, &rule2},+	{6103, 1, &rule83},+	{6104, 3, &rule2},+	{6107, 1, &rule3},+	{6108, 1, &rule45},+	{6109, 1, &rule84},+	{6112, 10, &rule8},+	{6128, 10, &rule17},+	{6144, 6, &rule2},+	{6150, 1, &rule7},+	{6151, 4, &rule2},+	{6155, 3, &rule84},+	{6158, 1, &rule1},+	{6160, 10, &rule8},+	{6176, 35, &rule45},+	{6211, 1, &rule83},+	{6212, 52, &rule45},+	{6272, 41, &rule45},+	{6313, 1, &rule84},+	{6314, 1, &rule45},+	{6320, 70, &rule45},+	{6400, 29, &rule45},+	{6432, 3, &rule84},+	{6435, 4, &rule114},+	{6439, 2, &rule84},+	{6441, 3, &rule114},+	{6448, 2, &rule114},+	{6450, 1, &rule84},+	{6451, 6, &rule114},+	{6457, 3, &rule84},+	{6464, 1, &rule13},+	{6468, 2, &rule2},+	{6470, 10, &rule8},+	{6480, 30, &rule45},+	{6512, 5, &rule45},+	{6528, 44, &rule45},+	{6576, 17, &rule114},+	{6593, 7, &rule45},+	{6600, 2, &rule114},+	{6608, 10, &rule8},+	{6618, 1, &rule17},+	{6622, 34, &rule13},+	{6656, 23, &rule45},+	{6679, 2, &rule84},+	{6681, 3, &rule114},+	{6686, 2, &rule2},+	{6688, 53, &rule45},+	{6741, 1, &rule114},+	{6742, 1, &rule84},+	{6743, 1, &rule114},+	{6744, 7, &rule84},+	{6752, 1, &rule84},+	{6753, 1, &rule114},+	{6754, 1, &rule84},+	{6755, 2, &rule114},+	{6757, 8, &rule84},+	{6765, 6, &rule114},+	{6771, 10, &rule84},+	{6783, 1, &rule84},+	{6784, 10, &rule8},+	{6800, 10, &rule8},+	{6816, 7, &rule2},+	{6823, 1, &rule83},+	{6824, 6, &rule2},+	{6912, 4, &rule84},+	{6916, 1, &rule114},+	{6917, 47, &rule45},+	{6964, 1, &rule84},+	{6965, 1, &rule114},+	{6966, 5, &rule84},+	{6971, 1, &rule114},+	{6972, 1, &rule84},+	{6973, 5, &rule114},+	{6978, 1, &rule84},+	{6979, 2, &rule114},+	{6981, 7, &rule45},+	{6992, 10, &rule8},+	{7002, 7, &rule2},+	{7009, 10, &rule13},+	{7019, 9, &rule84},+	{7028, 9, &rule13},+	{7040, 2, &rule84},+	{7042, 1, &rule114},+	{7043, 30, &rule45},+	{7073, 1, &rule114},+	{7074, 4, &rule84},+	{7078, 2, &rule114},+	{7080, 2, &rule84},+	{7082, 1, &rule114},+	{7086, 2, &rule45},+	{7088, 10, &rule8},+	{7104, 38, &rule45},+	{7142, 1, &rule84},+	{7143, 1, &rule114},+	{7144, 2, &rule84},+	{7146, 3, &rule114},+	{7149, 1, &rule84},+	{7150, 1, &rule114},+	{7151, 3, &rule84},+	{7154, 2, &rule114},+	{7164, 4, &rule2},+	{7168, 36, &rule45},+	{7204, 8, &rule114},+	{7212, 8, &rule84},+	{7220, 2, &rule114},+	{7222, 2, &rule84},+	{7227, 5, &rule2},+	{7232, 10, &rule8},+	{7245, 3, &rule45},+	{7248, 10, &rule8},+	{7258, 30, &rule45},+	{7288, 6, &rule83},+	{7294, 2, &rule2},+	{7376, 3, &rule84},+	{7379, 1, &rule2},+	{7380, 13, &rule84},+	{7393, 1, &rule114},+	{7394, 7, &rule84},+	{7401, 4, &rule45},+	{7405, 1, &rule84},+	{7406, 4, &rule45},+	{7410, 1, &rule114},+	{7424, 44, &rule14},+	{7468, 54, &rule83},+	{7522, 22, &rule14},+	{7544, 1, &rule83},+	{7545, 1, &rule117},+	{7546, 3, &rule14},+	{7549, 1, &rule118},+	{7550, 29, &rule14},+	{7579, 37, &rule83},+	{7616, 39, &rule84},+	{7676, 4, &rule84},+	{7680, 1, &rule21},+	{7681, 1, &rule22},+	{7682, 1, &rule21},+	{7683, 1, &rule22},+	{7684, 1, &rule21},+	{7685, 1, &rule22},+	{7686, 1, &rule21},+	{7687, 1, &rule22},+	{7688, 1, &rule21},+	{7689, 1, &rule22},+	{7690, 1, &rule21},+	{7691, 1, &rule22},+	{7692, 1, &rule21},+	{7693, 1, &rule22},+	{7694, 1, &rule21},+	{7695, 1, &rule22},+	{7696, 1, &rule21},+	{7697, 1, &rule22},+	{7698, 1, &rule21},+	{7699, 1, &rule22},+	{7700, 1, &rule21},+	{7701, 1, &rule22},+	{7702, 1, &rule21},+	{7703, 1, &rule22},+	{7704, 1, &rule21},+	{7705, 1, &rule22},+	{7706, 1, &rule21},+	{7707, 1, &rule22},+	{7708, 1, &rule21},+	{7709, 1, &rule22},+	{7710, 1, &rule21},+	{7711, 1, &rule22},+	{7712, 1, &rule21},+	{7713, 1, &rule22},+	{7714, 1, &rule21},+	{7715, 1, &rule22},+	{7716, 1, &rule21},+	{7717, 1, &rule22},+	{7718, 1, &rule21},+	{7719, 1, &rule22},+	{7720, 1, &rule21},+	{7721, 1, &rule22},+	{7722, 1, &rule21},+	{7723, 1, &rule22},+	{7724, 1, &rule21},+	{7725, 1, &rule22},+	{7726, 1, &rule21},+	{7727, 1, &rule22},+	{7728, 1, &rule21},+	{7729, 1, &rule22},+	{7730, 1, &rule21},+	{7731, 1, &rule22},+	{7732, 1, &rule21},+	{7733, 1, &rule22},+	{7734, 1, &rule21},+	{7735, 1, &rule22},+	{7736, 1, &rule21},+	{7737, 1, &rule22},+	{7738, 1, &rule21},+	{7739, 1, &rule22},+	{7740, 1, &rule21},+	{7741, 1, &rule22},+	{7742, 1, &rule21},+	{7743, 1, &rule22},+	{7744, 1, &rule21},+	{7745, 1, &rule22},+	{7746, 1, &rule21},+	{7747, 1, &rule22},+	{7748, 1, &rule21},+	{7749, 1, &rule22},+	{7750, 1, &rule21},+	{7751, 1, &rule22},+	{7752, 1, &rule21},+	{7753, 1, &rule22},+	{7754, 1, &rule21},+	{7755, 1, &rule22},+	{7756, 1, &rule21},+	{7757, 1, &rule22},+	{7758, 1, &rule21},+	{7759, 1, &rule22},+	{7760, 1, &rule21},+	{7761, 1, &rule22},+	{7762, 1, &rule21},+	{7763, 1, &rule22},+	{7764, 1, &rule21},+	{7765, 1, &rule22},+	{7766, 1, &rule21},+	{7767, 1, &rule22},+	{7768, 1, &rule21},+	{7769, 1, &rule22},+	{7770, 1, &rule21},+	{7771, 1, &rule22},+	{7772, 1, &rule21},+	{7773, 1, &rule22},+	{7774, 1, &rule21},+	{7775, 1, &rule22},+	{7776, 1, &rule21},+	{7777, 1, &rule22},+	{7778, 1, &rule21},+	{7779, 1, &rule22},+	{7780, 1, &rule21},+	{7781, 1, &rule22},+	{7782, 1, &rule21},+	{7783, 1, &rule22},+	{7784, 1, &rule21},+	{7785, 1, &rule22},+	{7786, 1, &rule21},+	{7787, 1, &rule22},+	{7788, 1, &rule21},+	{7789, 1, &rule22},+	{7790, 1, &rule21},+	{7791, 1, &rule22},+	{7792, 1, &rule21},+	{7793, 1, &rule22},+	{7794, 1, &rule21},+	{7795, 1, &rule22},+	{7796, 1, &rule21},+	{7797, 1, &rule22},+	{7798, 1, &rule21},+	{7799, 1, &rule22},+	{7800, 1, &rule21},+	{7801, 1, &rule22},+	{7802, 1, &rule21},+	{7803, 1, &rule22},+	{7804, 1, &rule21},+	{7805, 1, &rule22},+	{7806, 1, &rule21},+	{7807, 1, &rule22},+	{7808, 1, &rule21},+	{7809, 1, &rule22},+	{7810, 1, &rule21},+	{7811, 1, &rule22},+	{7812, 1, &rule21},+	{7813, 1, &rule22},+	{7814, 1, &rule21},+	{7815, 1, &rule22},+	{7816, 1, &rule21},+	{7817, 1, &rule22},+	{7818, 1, &rule21},+	{7819, 1, &rule22},+	{7820, 1, &rule21},+	{7821, 1, &rule22},+	{7822, 1, &rule21},+	{7823, 1, &rule22},+	{7824, 1, &rule21},+	{7825, 1, &rule22},+	{7826, 1, &rule21},+	{7827, 1, &rule22},+	{7828, 1, &rule21},+	{7829, 1, &rule22},+	{7830, 5, &rule14},+	{7835, 1, &rule119},+	{7836, 2, &rule14},+	{7838, 1, &rule120},+	{7839, 1, &rule14},+	{7840, 1, &rule21},+	{7841, 1, &rule22},+	{7842, 1, &rule21},+	{7843, 1, &rule22},+	{7844, 1, &rule21},+	{7845, 1, &rule22},+	{7846, 1, &rule21},+	{7847, 1, &rule22},+	{7848, 1, &rule21},+	{7849, 1, &rule22},+	{7850, 1, &rule21},+	{7851, 1, &rule22},+	{7852, 1, &rule21},+	{7853, 1, &rule22},+	{7854, 1, &rule21},+	{7855, 1, &rule22},+	{7856, 1, &rule21},+	{7857, 1, &rule22},+	{7858, 1, &rule21},+	{7859, 1, &rule22},+	{7860, 1, &rule21},+	{7861, 1, &rule22},+	{7862, 1, &rule21},+	{7863, 1, &rule22},+	{7864, 1, &rule21},+	{7865, 1, &rule22},+	{7866, 1, &rule21},+	{7867, 1, &rule22},+	{7868, 1, &rule21},+	{7869, 1, &rule22},+	{7870, 1, &rule21},+	{7871, 1, &rule22},+	{7872, 1, &rule21},+	{7873, 1, &rule22},+	{7874, 1, &rule21},+	{7875, 1, &rule22},+	{7876, 1, &rule21},+	{7877, 1, &rule22},+	{7878, 1, &rule21},+	{7879, 1, &rule22},+	{7880, 1, &rule21},+	{7881, 1, &rule22},+	{7882, 1, &rule21},+	{7883, 1, &rule22},+	{7884, 1, &rule21},+	{7885, 1, &rule22},+	{7886, 1, &rule21},+	{7887, 1, &rule22},+	{7888, 1, &rule21},+	{7889, 1, &rule22},+	{7890, 1, &rule21},+	{7891, 1, &rule22},+	{7892, 1, &rule21},+	{7893, 1, &rule22},+	{7894, 1, &rule21},+	{7895, 1, &rule22},+	{7896, 1, &rule21},+	{7897, 1, &rule22},+	{7898, 1, &rule21},+	{7899, 1, &rule22},+	{7900, 1, &rule21},+	{7901, 1, &rule22},+	{7902, 1, &rule21},+	{7903, 1, &rule22},+	{7904, 1, &rule21},+	{7905, 1, &rule22},+	{7906, 1, &rule21},+	{7907, 1, &rule22},+	{7908, 1, &rule21},+	{7909, 1, &rule22},+	{7910, 1, &rule21},+	{7911, 1, &rule22},+	{7912, 1, &rule21},+	{7913, 1, &rule22},+	{7914, 1, &rule21},+	{7915, 1, &rule22},+	{7916, 1, &rule21},+	{7917, 1, &rule22},+	{7918, 1, &rule21},+	{7919, 1, &rule22},+	{7920, 1, &rule21},+	{7921, 1, &rule22},+	{7922, 1, &rule21},+	{7923, 1, &rule22},+	{7924, 1, &rule21},+	{7925, 1, &rule22},+	{7926, 1, &rule21},+	{7927, 1, &rule22},+	{7928, 1, &rule21},+	{7929, 1, &rule22},+	{7930, 1, &rule21},+	{7931, 1, &rule22},+	{7932, 1, &rule21},+	{7933, 1, &rule22},+	{7934, 1, &rule21},+	{7935, 1, &rule22},+	{7936, 8, &rule121},+	{7944, 8, &rule122},+	{7952, 6, &rule121},+	{7960, 6, &rule122},+	{7968, 8, &rule121},+	{7976, 8, &rule122},+	{7984, 8, &rule121},+	{7992, 8, &rule122},+	{8000, 6, &rule121},+	{8008, 6, &rule122},+	{8016, 1, &rule14},+	{8017, 1, &rule121},+	{8018, 1, &rule14},+	{8019, 1, &rule121},+	{8020, 1, &rule14},+	{8021, 1, &rule121},+	{8022, 1, &rule14},+	{8023, 1, &rule121},+	{8025, 1, &rule122},+	{8027, 1, &rule122},+	{8029, 1, &rule122},+	{8031, 1, &rule122},+	{8032, 8, &rule121},+	{8040, 8, &rule122},+	{8048, 2, &rule123},+	{8050, 4, &rule124},+	{8054, 2, &rule125},+	{8056, 2, &rule126},+	{8058, 2, &rule127},+	{8060, 2, &rule128},+	{8064, 8, &rule121},+	{8072, 8, &rule129},+	{8080, 8, &rule121},+	{8088, 8, &rule129},+	{8096, 8, &rule121},+	{8104, 8, &rule129},+	{8112, 2, &rule121},+	{8114, 1, &rule14},+	{8115, 1, &rule130},+	{8116, 1, &rule14},+	{8118, 2, &rule14},+	{8120, 2, &rule122},+	{8122, 2, &rule131},+	{8124, 1, &rule132},+	{8125, 1, &rule10},+	{8126, 1, &rule133},+	{8127, 3, &rule10},+	{8130, 1, &rule14},+	{8131, 1, &rule130},+	{8132, 1, &rule14},+	{8134, 2, &rule14},+	{8136, 4, &rule134},+	{8140, 1, &rule132},+	{8141, 3, &rule10},+	{8144, 2, &rule121},+	{8146, 2, &rule14},+	{8150, 2, &rule14},+	{8152, 2, &rule122},+	{8154, 2, &rule135},+	{8157, 3, &rule10},+	{8160, 2, &rule121},+	{8162, 3, &rule14},+	{8165, 1, &rule104},+	{8166, 2, &rule14},+	{8168, 2, &rule122},+	{8170, 2, &rule136},+	{8172, 1, &rule107},+	{8173, 3, &rule10},+	{8178, 1, &rule14},+	{8179, 1, &rule130},+	{8180, 1, &rule14},+	{8182, 2, &rule14},+	{8184, 2, &rule137},+	{8186, 2, &rule138},+	{8188, 1, &rule132},+	{8189, 2, &rule10},+	{8192, 11, &rule1},+	{8203, 5, &rule16},+	{8208, 6, &rule7},+	{8214, 2, &rule2},+	{8216, 1, &rule15},+	{8217, 1, &rule19},+	{8218, 1, &rule4},+	{8219, 2, &rule15},+	{8221, 1, &rule19},+	{8222, 1, &rule4},+	{8223, 1, &rule15},+	{8224, 8, &rule2},+	{8232, 1, &rule139},+	{8233, 1, &rule140},+	{8234, 5, &rule16},+	{8239, 1, &rule1},+	{8240, 9, &rule2},+	{8249, 1, &rule15},+	{8250, 1, &rule19},+	{8251, 4, &rule2},+	{8255, 2, &rule11},+	{8257, 3, &rule2},+	{8260, 1, &rule6},+	{8261, 1, &rule4},+	{8262, 1, &rule5},+	{8263, 11, &rule2},+	{8274, 1, &rule6},+	{8275, 1, &rule2},+	{8276, 1, &rule11},+	{8277, 10, &rule2},+	{8287, 1, &rule1},+	{8288, 5, &rule16},+	{8298, 6, &rule16},+	{8304, 1, &rule17},+	{8305, 1, &rule83},+	{8308, 6, &rule17},+	{8314, 3, &rule6},+	{8317, 1, &rule4},+	{8318, 1, &rule5},+	{8319, 1, &rule83},+	{8320, 10, &rule17},+	{8330, 3, &rule6},+	{8333, 1, &rule4},+	{8334, 1, &rule5},+	{8336, 13, &rule83},+	{8352, 26, &rule3},+	{8400, 13, &rule84},+	{8413, 4, &rule109},+	{8417, 1, &rule84},+	{8418, 3, &rule109},+	{8421, 12, &rule84},+	{8448, 2, &rule13},+	{8450, 1, &rule98},+	{8451, 4, &rule13},+	{8455, 1, &rule98},+	{8456, 2, &rule13},+	{8458, 1, &rule14},+	{8459, 3, &rule98},+	{8462, 2, &rule14},+	{8464, 3, &rule98},+	{8467, 1, &rule14},+	{8468, 1, &rule13},+	{8469, 1, &rule98},+	{8470, 2, &rule13},+	{8472, 1, &rule6},+	{8473, 5, &rule98},+	{8478, 6, &rule13},+	{8484, 1, &rule98},+	{8485, 1, &rule13},+	{8486, 1, &rule141},+	{8487, 1, &rule13},+	{8488, 1, &rule98},+	{8489, 1, &rule13},+	{8490, 1, &rule142},+	{8491, 1, &rule143},+	{8492, 2, &rule98},+	{8494, 1, &rule13},+	{8495, 1, &rule14},+	{8496, 2, &rule98},+	{8498, 1, &rule144},+	{8499, 1, &rule98},+	{8500, 1, &rule14},+	{8501, 4, &rule45},+	{8505, 1, &rule14},+	{8506, 2, &rule13},+	{8508, 2, &rule14},+	{8510, 2, &rule98},+	{8512, 5, &rule6},+	{8517, 1, &rule98},+	{8518, 4, &rule14},+	{8522, 1, &rule13},+	{8523, 1, &rule6},+	{8524, 2, &rule13},+	{8526, 1, &rule145},+	{8527, 1, &rule13},+	{8528, 16, &rule17},+	{8544, 16, &rule146},+	{8560, 16, &rule147},+	{8576, 3, &rule116},+	{8579, 1, &rule21},+	{8580, 1, &rule22},+	{8581, 4, &rule116},+	{8585, 1, &rule17},+	{8592, 5, &rule6},+	{8597, 5, &rule13},+	{8602, 2, &rule6},+	{8604, 4, &rule13},+	{8608, 1, &rule6},+	{8609, 2, &rule13},+	{8611, 1, &rule6},+	{8612, 2, &rule13},+	{8614, 1, &rule6},+	{8615, 7, &rule13},+	{8622, 1, &rule6},+	{8623, 31, &rule13},+	{8654, 2, &rule6},+	{8656, 2, &rule13},+	{8658, 1, &rule6},+	{8659, 1, &rule13},+	{8660, 1, &rule6},+	{8661, 31, &rule13},+	{8692, 268, &rule6},+	{8960, 8, &rule13},+	{8968, 4, &rule6},+	{8972, 20, &rule13},+	{8992, 2, &rule6},+	{8994, 7, &rule13},+	{9001, 1, &rule4},+	{9002, 1, &rule5},+	{9003, 81, &rule13},+	{9084, 1, &rule6},+	{9085, 30, &rule13},+	{9115, 25, &rule6},+	{9140, 40, &rule13},+	{9180, 6, &rule6},+	{9186, 18, &rule13},+	{9216, 39, &rule13},+	{9280, 11, &rule13},+	{9312, 60, &rule17},+	{9372, 26, &rule13},+	{9398, 26, &rule148},+	{9424, 26, &rule149},+	{9450, 22, &rule17},+	{9472, 183, &rule13},+	{9655, 1, &rule6},+	{9656, 9, &rule13},+	{9665, 1, &rule6},+	{9666, 54, &rule13},+	{9720, 8, &rule6},+	{9728, 111, &rule13},+	{9839, 1, &rule6},+	{9840, 144, &rule13},+	{9985, 103, &rule13},+	{10088, 1, &rule4},+	{10089, 1, &rule5},+	{10090, 1, &rule4},+	{10091, 1, &rule5},+	{10092, 1, &rule4},+	{10093, 1, &rule5},+	{10094, 1, &rule4},+	{10095, 1, &rule5},+	{10096, 1, &rule4},+	{10097, 1, &rule5},+	{10098, 1, &rule4},+	{10099, 1, &rule5},+	{10100, 1, &rule4},+	{10101, 1, &rule5},+	{10102, 30, &rule17},+	{10132, 44, &rule13},+	{10176, 5, &rule6},+	{10181, 1, &rule4},+	{10182, 1, &rule5},+	{10183, 4, &rule6},+	{10188, 1, &rule6},+	{10190, 24, &rule6},+	{10214, 1, &rule4},+	{10215, 1, &rule5},+	{10216, 1, &rule4},+	{10217, 1, &rule5},+	{10218, 1, &rule4},+	{10219, 1, &rule5},+	{10220, 1, &rule4},+	{10221, 1, &rule5},+	{10222, 1, &rule4},+	{10223, 1, &rule5},+	{10224, 16, &rule6},+	{10240, 256, &rule13},+	{10496, 131, &rule6},+	{10627, 1, &rule4},+	{10628, 1, &rule5},+	{10629, 1, &rule4},+	{10630, 1, &rule5},+	{10631, 1, &rule4},+	{10632, 1, &rule5},+	{10633, 1, &rule4},+	{10634, 1, &rule5},+	{10635, 1, &rule4},+	{10636, 1, &rule5},+	{10637, 1, &rule4},+	{10638, 1, &rule5},+	{10639, 1, &rule4},+	{10640, 1, &rule5},+	{10641, 1, &rule4},+	{10642, 1, &rule5},+	{10643, 1, &rule4},+	{10644, 1, &rule5},+	{10645, 1, &rule4},+	{10646, 1, &rule5},+	{10647, 1, &rule4},+	{10648, 1, &rule5},+	{10649, 63, &rule6},+	{10712, 1, &rule4},+	{10713, 1, &rule5},+	{10714, 1, &rule4},+	{10715, 1, &rule5},+	{10716, 32, &rule6},+	{10748, 1, &rule4},+	{10749, 1, &rule5},+	{10750, 258, &rule6},+	{11008, 48, &rule13},+	{11056, 21, &rule6},+	{11077, 2, &rule13},+	{11079, 6, &rule6},+	{11088, 10, &rule13},+	{11264, 47, &rule112},+	{11312, 47, &rule113},+	{11360, 1, &rule21},+	{11361, 1, &rule22},+	{11362, 1, &rule150},+	{11363, 1, &rule151},+	{11364, 1, &rule152},+	{11365, 1, &rule153},+	{11366, 1, &rule154},+	{11367, 1, &rule21},+	{11368, 1, &rule22},+	{11369, 1, &rule21},+	{11370, 1, &rule22},+	{11371, 1, &rule21},+	{11372, 1, &rule22},+	{11373, 1, &rule155},+	{11374, 1, &rule156},+	{11375, 1, &rule157},+	{11376, 1, &rule158},+	{11377, 1, &rule14},+	{11378, 1, &rule21},+	{11379, 1, &rule22},+	{11380, 1, &rule14},+	{11381, 1, &rule21},+	{11382, 1, &rule22},+	{11383, 6, &rule14},+	{11389, 1, &rule83},+	{11390, 2, &rule159},+	{11392, 1, &rule21},+	{11393, 1, &rule22},+	{11394, 1, &rule21},+	{11395, 1, &rule22},+	{11396, 1, &rule21},+	{11397, 1, &rule22},+	{11398, 1, &rule21},+	{11399, 1, &rule22},+	{11400, 1, &rule21},+	{11401, 1, &rule22},+	{11402, 1, &rule21},+	{11403, 1, &rule22},+	{11404, 1, &rule21},+	{11405, 1, &rule22},+	{11406, 1, &rule21},+	{11407, 1, &rule22},+	{11408, 1, &rule21},+	{11409, 1, &rule22},+	{11410, 1, &rule21},+	{11411, 1, &rule22},+	{11412, 1, &rule21},+	{11413, 1, &rule22},+	{11414, 1, &rule21},+	{11415, 1, &rule22},+	{11416, 1, &rule21},+	{11417, 1, &rule22},+	{11418, 1, &rule21},+	{11419, 1, &rule22},+	{11420, 1, &rule21},+	{11421, 1, &rule22},+	{11422, 1, &rule21},+	{11423, 1, &rule22},+	{11424, 1, &rule21},+	{11425, 1, &rule22},+	{11426, 1, &rule21},+	{11427, 1, &rule22},+	{11428, 1, &rule21},+	{11429, 1, &rule22},+	{11430, 1, &rule21},+	{11431, 1, &rule22},+	{11432, 1, &rule21},+	{11433, 1, &rule22},+	{11434, 1, &rule21},+	{11435, 1, &rule22},+	{11436, 1, &rule21},+	{11437, 1, &rule22},+	{11438, 1, &rule21},+	{11439, 1, &rule22},+	{11440, 1, &rule21},+	{11441, 1, &rule22},+	{11442, 1, &rule21},+	{11443, 1, &rule22},+	{11444, 1, &rule21},+	{11445, 1, &rule22},+	{11446, 1, &rule21},+	{11447, 1, &rule22},+	{11448, 1, &rule21},+	{11449, 1, &rule22},+	{11450, 1, &rule21},+	{11451, 1, &rule22},+	{11452, 1, &rule21},+	{11453, 1, &rule22},+	{11454, 1, &rule21},+	{11455, 1, &rule22},+	{11456, 1, &rule21},+	{11457, 1, &rule22},+	{11458, 1, &rule21},+	{11459, 1, &rule22},+	{11460, 1, &rule21},+	{11461, 1, &rule22},+	{11462, 1, &rule21},+	{11463, 1, &rule22},+	{11464, 1, &rule21},+	{11465, 1, &rule22},+	{11466, 1, &rule21},+	{11467, 1, &rule22},+	{11468, 1, &rule21},+	{11469, 1, &rule22},+	{11470, 1, &rule21},+	{11471, 1, &rule22},+	{11472, 1, &rule21},+	{11473, 1, &rule22},+	{11474, 1, &rule21},+	{11475, 1, &rule22},+	{11476, 1, &rule21},+	{11477, 1, &rule22},+	{11478, 1, &rule21},+	{11479, 1, &rule22},+	{11480, 1, &rule21},+	{11481, 1, &rule22},+	{11482, 1, &rule21},+	{11483, 1, &rule22},+	{11484, 1, &rule21},+	{11485, 1, &rule22},+	{11486, 1, &rule21},+	{11487, 1, &rule22},+	{11488, 1, &rule21},+	{11489, 1, &rule22},+	{11490, 1, &rule21},+	{11491, 1, &rule22},+	{11492, 1, &rule14},+	{11493, 6, &rule13},+	{11499, 1, &rule21},+	{11500, 1, &rule22},+	{11501, 1, &rule21},+	{11502, 1, &rule22},+	{11503, 3, &rule84},+	{11513, 4, &rule2},+	{11517, 1, &rule17},+	{11518, 2, &rule2},+	{11520, 38, &rule160},+	{11568, 54, &rule45},+	{11631, 1, &rule83},+	{11632, 1, &rule2},+	{11647, 1, &rule84},+	{11648, 23, &rule45},+	{11680, 7, &rule45},+	{11688, 7, &rule45},+	{11696, 7, &rule45},+	{11704, 7, &rule45},+	{11712, 7, &rule45},+	{11720, 7, &rule45},+	{11728, 7, &rule45},+	{11736, 7, &rule45},+	{11744, 32, &rule84},+	{11776, 2, &rule2},+	{11778, 1, &rule15},+	{11779, 1, &rule19},+	{11780, 1, &rule15},+	{11781, 1, &rule19},+	{11782, 3, &rule2},+	{11785, 1, &rule15},+	{11786, 1, &rule19},+	{11787, 1, &rule2},+	{11788, 1, &rule15},+	{11789, 1, &rule19},+	{11790, 9, &rule2},+	{11799, 1, &rule7},+	{11800, 2, &rule2},+	{11802, 1, &rule7},+	{11803, 1, &rule2},+	{11804, 1, &rule15},+	{11805, 1, &rule19},+	{11806, 2, &rule2},+	{11808, 1, &rule15},+	{11809, 1, &rule19},+	{11810, 1, &rule4},+	{11811, 1, &rule5},+	{11812, 1, &rule4},+	{11813, 1, &rule5},+	{11814, 1, &rule4},+	{11815, 1, &rule5},+	{11816, 1, &rule4},+	{11817, 1, &rule5},+	{11818, 5, &rule2},+	{11823, 1, &rule83},+	{11824, 2, &rule2},+	{11904, 26, &rule13},+	{11931, 89, &rule13},+	{12032, 214, &rule13},+	{12272, 12, &rule13},+	{12288, 1, &rule1},+	{12289, 3, &rule2},+	{12292, 1, &rule13},+	{12293, 1, &rule83},+	{12294, 1, &rule45},+	{12295, 1, &rule116},+	{12296, 1, &rule4},+	{12297, 1, &rule5},+	{12298, 1, &rule4},+	{12299, 1, &rule5},+	{12300, 1, &rule4},+	{12301, 1, &rule5},+	{12302, 1, &rule4},+	{12303, 1, &rule5},+	{12304, 1, &rule4},+	{12305, 1, &rule5},+	{12306, 2, &rule13},+	{12308, 1, &rule4},+	{12309, 1, &rule5},+	{12310, 1, &rule4},+	{12311, 1, &rule5},+	{12312, 1, &rule4},+	{12313, 1, &rule5},+	{12314, 1, &rule4},+	{12315, 1, &rule5},+	{12316, 1, &rule7},+	{12317, 1, &rule4},+	{12318, 2, &rule5},+	{12320, 1, &rule13},+	{12321, 9, &rule116},+	{12330, 6, &rule84},+	{12336, 1, &rule7},+	{12337, 5, &rule83},+	{12342, 2, &rule13},+	{12344, 3, &rule116},+	{12347, 1, &rule83},+	{12348, 1, &rule45},+	{12349, 1, &rule2},+	{12350, 2, &rule13},+	{12353, 86, &rule45},+	{12441, 2, &rule84},+	{12443, 2, &rule10},+	{12445, 2, &rule83},+	{12447, 1, &rule45},+	{12448, 1, &rule7},+	{12449, 90, &rule45},+	{12539, 1, &rule2},+	{12540, 3, &rule83},+	{12543, 1, &rule45},+	{12549, 41, &rule45},+	{12593, 94, &rule45},+	{12688, 2, &rule13},+	{12690, 4, &rule17},+	{12694, 10, &rule13},+	{12704, 27, &rule45},+	{12736, 36, &rule13},+	{12784, 16, &rule45},+	{12800, 31, &rule13},+	{12832, 10, &rule17},+	{12842, 39, &rule13},+	{12881, 15, &rule17},+	{12896, 32, &rule13},+	{12928, 10, &rule17},+	{12938, 39, &rule13},+	{12977, 15, &rule17},+	{12992, 63, &rule13},+	{13056, 256, &rule13},+	{13312, 6582, &rule45},+	{19904, 64, &rule13},+	{19968, 20940, &rule45},+	{40960, 21, &rule45},+	{40981, 1, &rule83},+	{40982, 1143, &rule45},+	{42128, 55, &rule13},+	{42192, 40, &rule45},+	{42232, 6, &rule83},+	{42238, 2, &rule2},+	{42240, 268, &rule45},+	{42508, 1, &rule83},+	{42509, 3, &rule2},+	{42512, 16, &rule45},+	{42528, 10, &rule8},+	{42538, 2, &rule45},+	{42560, 1, &rule21},+	{42561, 1, &rule22},+	{42562, 1, &rule21},+	{42563, 1, &rule22},+	{42564, 1, &rule21},+	{42565, 1, &rule22},+	{42566, 1, &rule21},+	{42567, 1, &rule22},+	{42568, 1, &rule21},+	{42569, 1, &rule22},+	{42570, 1, &rule21},+	{42571, 1, &rule22},+	{42572, 1, &rule21},+	{42573, 1, &rule22},+	{42574, 1, &rule21},+	{42575, 1, &rule22},+	{42576, 1, &rule21},+	{42577, 1, &rule22},+	{42578, 1, &rule21},+	{42579, 1, &rule22},+	{42580, 1, &rule21},+	{42581, 1, &rule22},+	{42582, 1, &rule21},+	{42583, 1, &rule22},+	{42584, 1, &rule21},+	{42585, 1, &rule22},+	{42586, 1, &rule21},+	{42587, 1, &rule22},+	{42588, 1, &rule21},+	{42589, 1, &rule22},+	{42590, 1, &rule21},+	{42591, 1, &rule22},+	{42592, 1, &rule21},+	{42593, 1, &rule22},+	{42594, 1, &rule21},+	{42595, 1, &rule22},+	{42596, 1, &rule21},+	{42597, 1, &rule22},+	{42598, 1, &rule21},+	{42599, 1, &rule22},+	{42600, 1, &rule21},+	{42601, 1, &rule22},+	{42602, 1, &rule21},+	{42603, 1, &rule22},+	{42604, 1, &rule21},+	{42605, 1, &rule22},+	{42606, 1, &rule45},+	{42607, 1, &rule84},+	{42608, 3, &rule109},+	{42611, 1, &rule2},+	{42620, 2, &rule84},+	{42622, 1, &rule2},+	{42623, 1, &rule83},+	{42624, 1, &rule21},+	{42625, 1, &rule22},+	{42626, 1, &rule21},+	{42627, 1, &rule22},+	{42628, 1, &rule21},+	{42629, 1, &rule22},+	{42630, 1, &rule21},+	{42631, 1, &rule22},+	{42632, 1, &rule21},+	{42633, 1, &rule22},+	{42634, 1, &rule21},+	{42635, 1, &rule22},+	{42636, 1, &rule21},+	{42637, 1, &rule22},+	{42638, 1, &rule21},+	{42639, 1, &rule22},+	{42640, 1, &rule21},+	{42641, 1, &rule22},+	{42642, 1, &rule21},+	{42643, 1, &rule22},+	{42644, 1, &rule21},+	{42645, 1, &rule22},+	{42646, 1, &rule21},+	{42647, 1, &rule22},+	{42656, 70, &rule45},+	{42726, 10, &rule116},+	{42736, 2, &rule84},+	{42738, 6, &rule2},+	{42752, 23, &rule10},+	{42775, 9, &rule83},+	{42784, 2, &rule10},+	{42786, 1, &rule21},+	{42787, 1, &rule22},+	{42788, 1, &rule21},+	{42789, 1, &rule22},+	{42790, 1, &rule21},+	{42791, 1, &rule22},+	{42792, 1, &rule21},+	{42793, 1, &rule22},+	{42794, 1, &rule21},+	{42795, 1, &rule22},+	{42796, 1, &rule21},+	{42797, 1, &rule22},+	{42798, 1, &rule21},+	{42799, 1, &rule22},+	{42800, 2, &rule14},+	{42802, 1, &rule21},+	{42803, 1, &rule22},+	{42804, 1, &rule21},+	{42805, 1, &rule22},+	{42806, 1, &rule21},+	{42807, 1, &rule22},+	{42808, 1, &rule21},+	{42809, 1, &rule22},+	{42810, 1, &rule21},+	{42811, 1, &rule22},+	{42812, 1, &rule21},+	{42813, 1, &rule22},+	{42814, 1, &rule21},+	{42815, 1, &rule22},+	{42816, 1, &rule21},+	{42817, 1, &rule22},+	{42818, 1, &rule21},+	{42819, 1, &rule22},+	{42820, 1, &rule21},+	{42821, 1, &rule22},+	{42822, 1, &rule21},+	{42823, 1, &rule22},+	{42824, 1, &rule21},+	{42825, 1, &rule22},+	{42826, 1, &rule21},+	{42827, 1, &rule22},+	{42828, 1, &rule21},+	{42829, 1, &rule22},+	{42830, 1, &rule21},+	{42831, 1, &rule22},+	{42832, 1, &rule21},+	{42833, 1, &rule22},+	{42834, 1, &rule21},+	{42835, 1, &rule22},+	{42836, 1, &rule21},+	{42837, 1, &rule22},+	{42838, 1, &rule21},+	{42839, 1, &rule22},+	{42840, 1, &rule21},+	{42841, 1, &rule22},+	{42842, 1, &rule21},+	{42843, 1, &rule22},+	{42844, 1, &rule21},+	{42845, 1, &rule22},+	{42846, 1, &rule21},+	{42847, 1, &rule22},+	{42848, 1, &rule21},+	{42849, 1, &rule22},+	{42850, 1, &rule21},+	{42851, 1, &rule22},+	{42852, 1, &rule21},+	{42853, 1, &rule22},+	{42854, 1, &rule21},+	{42855, 1, &rule22},+	{42856, 1, &rule21},+	{42857, 1, &rule22},+	{42858, 1, &rule21},+	{42859, 1, &rule22},+	{42860, 1, &rule21},+	{42861, 1, &rule22},+	{42862, 1, &rule21},+	{42863, 1, &rule22},+	{42864, 1, &rule83},+	{42865, 8, &rule14},+	{42873, 1, &rule21},+	{42874, 1, &rule22},+	{42875, 1, &rule21},+	{42876, 1, &rule22},+	{42877, 1, &rule161},+	{42878, 1, &rule21},+	{42879, 1, &rule22},+	{42880, 1, &rule21},+	{42881, 1, &rule22},+	{42882, 1, &rule21},+	{42883, 1, &rule22},+	{42884, 1, &rule21},+	{42885, 1, &rule22},+	{42886, 1, &rule21},+	{42887, 1, &rule22},+	{42888, 1, &rule83},+	{42889, 2, &rule10},+	{42891, 1, &rule21},+	{42892, 1, &rule22},+	{42893, 1, &rule162},+	{42894, 1, &rule14},+	{42896, 1, &rule21},+	{42897, 1, &rule22},+	{42912, 1, &rule21},+	{42913, 1, &rule22},+	{42914, 1, &rule21},+	{42915, 1, &rule22},+	{42916, 1, &rule21},+	{42917, 1, &rule22},+	{42918, 1, &rule21},+	{42919, 1, &rule22},+	{42920, 1, &rule21},+	{42921, 1, &rule22},+	{43002, 1, &rule14},+	{43003, 7, &rule45},+	{43010, 1, &rule84},+	{43011, 3, &rule45},+	{43014, 1, &rule84},+	{43015, 4, &rule45},+	{43019, 1, &rule84},+	{43020, 23, &rule45},+	{43043, 2, &rule114},+	{43045, 2, &rule84},+	{43047, 1, &rule114},+	{43048, 4, &rule13},+	{43056, 6, &rule17},+	{43062, 2, &rule13},+	{43064, 1, &rule3},+	{43065, 1, &rule13},+	{43072, 52, &rule45},+	{43124, 4, &rule2},+	{43136, 2, &rule114},+	{43138, 50, &rule45},+	{43188, 16, &rule114},+	{43204, 1, &rule84},+	{43214, 2, &rule2},+	{43216, 10, &rule8},+	{43232, 18, &rule84},+	{43250, 6, &rule45},+	{43256, 3, &rule2},+	{43259, 1, &rule45},+	{43264, 10, &rule8},+	{43274, 28, &rule45},+	{43302, 8, &rule84},+	{43310, 2, &rule2},+	{43312, 23, &rule45},+	{43335, 11, &rule84},+	{43346, 2, &rule114},+	{43359, 1, &rule2},+	{43360, 29, &rule45},+	{43392, 3, &rule84},+	{43395, 1, &rule114},+	{43396, 47, &rule45},+	{43443, 1, &rule84},+	{43444, 2, &rule114},+	{43446, 4, &rule84},+	{43450, 2, &rule114},+	{43452, 1, &rule84},+	{43453, 4, &rule114},+	{43457, 13, &rule2},+	{43471, 1, &rule83},+	{43472, 10, &rule8},+	{43486, 2, &rule2},+	{43520, 41, &rule45},+	{43561, 6, &rule84},+	{43567, 2, &rule114},+	{43569, 2, &rule84},+	{43571, 2, &rule114},+	{43573, 2, &rule84},+	{43584, 3, &rule45},+	{43587, 1, &rule84},+	{43588, 8, &rule45},+	{43596, 1, &rule84},+	{43597, 1, &rule114},+	{43600, 10, &rule8},+	{43612, 4, &rule2},+	{43616, 16, &rule45},+	{43632, 1, &rule83},+	{43633, 6, &rule45},+	{43639, 3, &rule13},+	{43642, 1, &rule45},+	{43643, 1, &rule114},+	{43648, 48, &rule45},+	{43696, 1, &rule84},+	{43697, 1, &rule45},+	{43698, 3, &rule84},+	{43701, 2, &rule45},+	{43703, 2, &rule84},+	{43705, 5, &rule45},+	{43710, 2, &rule84},+	{43712, 1, &rule45},+	{43713, 1, &rule84},+	{43714, 1, &rule45},+	{43739, 2, &rule45},+	{43741, 1, &rule83},+	{43742, 2, &rule2},+	{43777, 6, &rule45},+	{43785, 6, &rule45},+	{43793, 6, &rule45},+	{43808, 7, &rule45},+	{43816, 7, &rule45},+	{43968, 35, &rule45},+	{44003, 2, &rule114},+	{44005, 1, &rule84},+	{44006, 2, &rule114},+	{44008, 1, &rule84},+	{44009, 2, &rule114},+	{44011, 1, &rule2},+	{44012, 1, &rule114},+	{44013, 1, &rule84},+	{44016, 10, &rule8},+	{44032, 11172, &rule45},+	{55216, 23, &rule45},+	{55243, 49, &rule45},+	{55296, 896, &rule163},+	{56192, 128, &rule163},+	{56320, 1024, &rule163},+	{57344, 6400, &rule164},+	{63744, 302, &rule45},+	{64048, 62, &rule45},+	{64112, 106, &rule45},+	{64256, 7, &rule14},+	{64275, 5, &rule14},+	{64285, 1, &rule45},+	{64286, 1, &rule84},+	{64287, 10, &rule45},+	{64297, 1, &rule6},+	{64298, 13, &rule45},+	{64312, 5, &rule45},+	{64318, 1, &rule45},+	{64320, 2, &rule45},+	{64323, 2, &rule45},+	{64326, 108, &rule45},+	{64434, 16, &rule10},+	{64467, 363, &rule45},+	{64830, 1, &rule4},+	{64831, 1, &rule5},+	{64848, 64, &rule45},+	{64914, 54, &rule45},+	{65008, 12, &rule45},+	{65020, 1, &rule3},+	{65021, 1, &rule13},+	{65024, 16, &rule84},+	{65040, 7, &rule2},+	{65047, 1, &rule4},+	{65048, 1, &rule5},+	{65049, 1, &rule2},+	{65056, 7, &rule84},+	{65072, 1, &rule2},+	{65073, 2, &rule7},+	{65075, 2, &rule11},+	{65077, 1, &rule4},+	{65078, 1, &rule5},+	{65079, 1, &rule4},+	{65080, 1, &rule5},+	{65081, 1, &rule4},+	{65082, 1, &rule5},+	{65083, 1, &rule4},+	{65084, 1, &rule5},+	{65085, 1, &rule4},+	{65086, 1, &rule5},+	{65087, 1, &rule4},+	{65088, 1, &rule5},+	{65089, 1, &rule4},+	{65090, 1, &rule5},+	{65091, 1, &rule4},+	{65092, 1, &rule5},+	{65093, 2, &rule2},+	{65095, 1, &rule4},+	{65096, 1, &rule5},+	{65097, 4, &rule2},+	{65101, 3, &rule11},+	{65104, 3, &rule2},+	{65108, 4, &rule2},+	{65112, 1, &rule7},+	{65113, 1, &rule4},+	{65114, 1, &rule5},+	{65115, 1, &rule4},+	{65116, 1, &rule5},+	{65117, 1, &rule4},+	{65118, 1, &rule5},+	{65119, 3, &rule2},+	{65122, 1, &rule6},+	{65123, 1, &rule7},+	{65124, 3, &rule6},+	{65128, 1, &rule2},+	{65129, 1, &rule3},+	{65130, 2, &rule2},+	{65136, 5, &rule45},+	{65142, 135, &rule45},+	{65279, 1, &rule16},+	{65281, 3, &rule2},+	{65284, 1, &rule3},+	{65285, 3, &rule2},+	{65288, 1, &rule4},+	{65289, 1, &rule5},+	{65290, 1, &rule2},+	{65291, 1, &rule6},+	{65292, 1, &rule2},+	{65293, 1, &rule7},+	{65294, 2, &rule2},+	{65296, 10, &rule8},+	{65306, 2, &rule2},+	{65308, 3, &rule6},+	{65311, 2, &rule2},+	{65313, 26, &rule9},+	{65339, 1, &rule4},+	{65340, 1, &rule2},+	{65341, 1, &rule5},+	{65342, 1, &rule10},+	{65343, 1, &rule11},+	{65344, 1, &rule10},+	{65345, 26, &rule12},+	{65371, 1, &rule4},+	{65372, 1, &rule6},+	{65373, 1, &rule5},+	{65374, 1, &rule6},+	{65375, 1, &rule4},+	{65376, 1, &rule5},+	{65377, 1, &rule2},+	{65378, 1, &rule4},+	{65379, 1, &rule5},+	{65380, 2, &rule2},+	{65382, 10, &rule45},+	{65392, 1, &rule83},+	{65393, 45, &rule45},+	{65438, 2, &rule83},+	{65440, 31, &rule45},+	{65474, 6, &rule45},+	{65482, 6, &rule45},+	{65490, 6, &rule45},+	{65498, 3, &rule45},+	{65504, 2, &rule3},+	{65506, 1, &rule6},+	{65507, 1, &rule10},+	{65508, 1, &rule13},+	{65509, 2, &rule3},+	{65512, 1, &rule13},+	{65513, 4, &rule6},+	{65517, 2, &rule13},+	{65529, 3, &rule16},+	{65532, 2, &rule13},+	{65536, 12, &rule45},+	{65549, 26, &rule45},+	{65576, 19, &rule45},+	{65596, 2, &rule45},+	{65599, 15, &rule45},+	{65616, 14, &rule45},+	{65664, 123, &rule45},+	{65792, 2, &rule2},+	{65794, 1, &rule13},+	{65799, 45, &rule17},+	{65847, 9, &rule13},+	{65856, 53, &rule116},+	{65909, 4, &rule17},+	{65913, 17, &rule13},+	{65930, 1, &rule17},+	{65936, 12, &rule13},+	{66000, 45, &rule13},+	{66045, 1, &rule84},+	{66176, 29, &rule45},+	{66208, 49, &rule45},+	{66304, 31, &rule45},+	{66336, 4, &rule17},+	{66352, 17, &rule45},+	{66369, 1, &rule116},+	{66370, 8, &rule45},+	{66378, 1, &rule116},+	{66432, 30, &rule45},+	{66463, 1, &rule2},+	{66464, 36, &rule45},+	{66504, 8, &rule45},+	{66512, 1, &rule2},+	{66513, 5, &rule116},+	{66560, 40, &rule165},+	{66600, 40, &rule166},+	{66640, 78, &rule45},+	{66720, 10, &rule8},+	{67584, 6, &rule45},+	{67592, 1, &rule45},+	{67594, 44, &rule45},+	{67639, 2, &rule45},+	{67644, 1, &rule45},+	{67647, 23, &rule45},+	{67671, 1, &rule2},+	{67672, 8, &rule17},+	{67840, 22, &rule45},+	{67862, 6, &rule17},+	{67871, 1, &rule2},+	{67872, 26, &rule45},+	{67903, 1, &rule2},+	{68096, 1, &rule45},+	{68097, 3, &rule84},+	{68101, 2, &rule84},+	{68108, 4, &rule84},+	{68112, 4, &rule45},+	{68117, 3, &rule45},+	{68121, 27, &rule45},+	{68152, 3, &rule84},+	{68159, 1, &rule84},+	{68160, 8, &rule17},+	{68176, 9, &rule2},+	{68192, 29, &rule45},+	{68221, 2, &rule17},+	{68223, 1, &rule2},+	{68352, 54, &rule45},+	{68409, 7, &rule2},+	{68416, 22, &rule45},+	{68440, 8, &rule17},+	{68448, 19, &rule45},+	{68472, 8, &rule17},+	{68608, 73, &rule45},+	{69216, 31, &rule17},+	{69632, 1, &rule114},+	{69633, 1, &rule84},+	{69634, 1, &rule114},+	{69635, 53, &rule45},+	{69688, 15, &rule84},+	{69703, 7, &rule2},+	{69714, 20, &rule17},+	{69734, 10, &rule8},+	{69760, 2, &rule84},+	{69762, 1, &rule114},+	{69763, 45, &rule45},+	{69808, 3, &rule114},+	{69811, 4, &rule84},+	{69815, 2, &rule114},+	{69817, 2, &rule84},+	{69819, 2, &rule2},+	{69821, 1, &rule16},+	{69822, 4, &rule2},+	{73728, 879, &rule45},+	{74752, 99, &rule116},+	{74864, 4, &rule2},+	{77824, 1071, &rule45},+	{92160, 569, &rule45},+	{110592, 2, &rule45},+	{118784, 246, &rule13},+	{119040, 39, &rule13},+	{119081, 60, &rule13},+	{119141, 2, &rule114},+	{119143, 3, &rule84},+	{119146, 3, &rule13},+	{119149, 6, &rule114},+	{119155, 8, &rule16},+	{119163, 8, &rule84},+	{119171, 2, &rule13},+	{119173, 7, &rule84},+	{119180, 30, &rule13},+	{119210, 4, &rule84},+	{119214, 48, &rule13},+	{119296, 66, &rule13},+	{119362, 3, &rule84},+	{119365, 1, &rule13},+	{119552, 87, &rule13},+	{119648, 18, &rule17},+	{119808, 26, &rule98},+	{119834, 26, &rule14},+	{119860, 26, &rule98},+	{119886, 7, &rule14},+	{119894, 18, &rule14},+	{119912, 26, &rule98},+	{119938, 26, &rule14},+	{119964, 1, &rule98},+	{119966, 2, &rule98},+	{119970, 1, &rule98},+	{119973, 2, &rule98},+	{119977, 4, &rule98},+	{119982, 8, &rule98},+	{119990, 4, &rule14},+	{119995, 1, &rule14},+	{119997, 7, &rule14},+	{120005, 11, &rule14},+	{120016, 26, &rule98},+	{120042, 26, &rule14},+	{120068, 2, &rule98},+	{120071, 4, &rule98},+	{120077, 8, &rule98},+	{120086, 7, &rule98},+	{120094, 26, &rule14},+	{120120, 2, &rule98},+	{120123, 4, &rule98},+	{120128, 5, &rule98},+	{120134, 1, &rule98},+	{120138, 7, &rule98},+	{120146, 26, &rule14},+	{120172, 26, &rule98},+	{120198, 26, &rule14},+	{120224, 26, &rule98},+	{120250, 26, &rule14},+	{120276, 26, &rule98},+	{120302, 26, &rule14},+	{120328, 26, &rule98},+	{120354, 26, &rule14},+	{120380, 26, &rule98},+	{120406, 26, &rule14},+	{120432, 26, &rule98},+	{120458, 28, &rule14},+	{120488, 25, &rule98},+	{120513, 1, &rule6},+	{120514, 25, &rule14},+	{120539, 1, &rule6},+	{120540, 6, &rule14},+	{120546, 25, &rule98},+	{120571, 1, &rule6},+	{120572, 25, &rule14},+	{120597, 1, &rule6},+	{120598, 6, &rule14},+	{120604, 25, &rule98},+	{120629, 1, &rule6},+	{120630, 25, &rule14},+	{120655, 1, &rule6},+	{120656, 6, &rule14},+	{120662, 25, &rule98},+	{120687, 1, &rule6},+	{120688, 25, &rule14},+	{120713, 1, &rule6},+	{120714, 6, &rule14},+	{120720, 25, &rule98},+	{120745, 1, &rule6},+	{120746, 25, &rule14},+	{120771, 1, &rule6},+	{120772, 6, &rule14},+	{120778, 1, &rule98},+	{120779, 1, &rule14},+	{120782, 50, &rule8},+	{126976, 44, &rule13},+	{127024, 100, &rule13},+	{127136, 15, &rule13},+	{127153, 14, &rule13},+	{127169, 15, &rule13},+	{127185, 15, &rule13},+	{127232, 11, &rule17},+	{127248, 31, &rule13},+	{127280, 58, &rule13},+	{127344, 43, &rule13},+	{127462, 29, &rule13},+	{127504, 43, &rule13},+	{127552, 9, &rule13},+	{127568, 2, &rule13},+	{127744, 33, &rule13},+	{127792, 6, &rule13},+	{127799, 70, &rule13},+	{127872, 20, &rule13},+	{127904, 37, &rule13},+	{127942, 5, &rule13},+	{127968, 17, &rule13},+	{128000, 63, &rule13},+	{128064, 1, &rule13},+	{128066, 182, &rule13},+	{128249, 4, &rule13},+	{128256, 62, &rule13},+	{128336, 24, &rule13},+	{128507, 5, &rule13},+	{128513, 16, &rule13},+	{128530, 3, &rule13},+	{128534, 1, &rule13},+	{128536, 1, &rule13},+	{128538, 1, &rule13},+	{128540, 3, &rule13},+	{128544, 6, &rule13},+	{128552, 4, &rule13},+	{128557, 1, &rule13},+	{128560, 4, &rule13},+	{128565, 12, &rule13},+	{128581, 11, &rule13},+	{128640, 70, &rule13},+	{128768, 116, &rule13},+	{131072, 42711, &rule45},+	{173824, 4149, &rule45},+	{177984, 222, &rule45},+	{194560, 542, &rule45},+	{917505, 1, &rule16},+	{917536, 96, &rule16},+	{917760, 240, &rule84},+	{983040, 65534, &rule164},+	{1048576, 65534, &rule164}+};+static const struct _charblock_ convchars[]={+	{65, 26, &rule9},+	{97, 26, &rule12},+	{181, 1, &rule18},+	{192, 23, &rule9},+	{216, 7, &rule9},+	{224, 23, &rule12},+	{248, 7, &rule12},+	{255, 1, &rule20},+	{256, 1, &rule21},+	{257, 1, &rule22},+	{258, 1, &rule21},+	{259, 1, &rule22},+	{260, 1, &rule21},+	{261, 1, &rule22},+	{262, 1, &rule21},+	{263, 1, &rule22},+	{264, 1, &rule21},+	{265, 1, &rule22},+	{266, 1, &rule21},+	{267, 1, &rule22},+	{268, 1, &rule21},+	{269, 1, &rule22},+	{270, 1, &rule21},+	{271, 1, &rule22},+	{272, 1, &rule21},+	{273, 1, &rule22},+	{274, 1, &rule21},+	{275, 1, &rule22},+	{276, 1, &rule21},+	{277, 1, &rule22},+	{278, 1, &rule21},+	{279, 1, &rule22},+	{280, 1, &rule21},+	{281, 1, &rule22},+	{282, 1, &rule21},+	{283, 1, &rule22},+	{284, 1, &rule21},+	{285, 1, &rule22},+	{286, 1, &rule21},+	{287, 1, &rule22},+	{288, 1, &rule21},+	{289, 1, &rule22},+	{290, 1, &rule21},+	{291, 1, &rule22},+	{292, 1, &rule21},+	{293, 1, &rule22},+	{294, 1, &rule21},+	{295, 1, &rule22},+	{296, 1, &rule21},+	{297, 1, &rule22},+	{298, 1, &rule21},+	{299, 1, &rule22},+	{300, 1, &rule21},+	{301, 1, &rule22},+	{302, 1, &rule21},+	{303, 1, &rule22},+	{304, 1, &rule23},+	{305, 1, &rule24},+	{306, 1, &rule21},+	{307, 1, &rule22},+	{308, 1, &rule21},+	{309, 1, &rule22},+	{310, 1, &rule21},+	{311, 1, &rule22},+	{313, 1, &rule21},+	{314, 1, &rule22},+	{315, 1, &rule21},+	{316, 1, &rule22},+	{317, 1, &rule21},+	{318, 1, &rule22},+	{319, 1, &rule21},+	{320, 1, &rule22},+	{321, 1, &rule21},+	{322, 1, &rule22},+	{323, 1, &rule21},+	{324, 1, &rule22},+	{325, 1, &rule21},+	{326, 1, &rule22},+	{327, 1, &rule21},+	{328, 1, &rule22},+	{330, 1, &rule21},+	{331, 1, &rule22},+	{332, 1, &rule21},+	{333, 1, &rule22},+	{334, 1, &rule21},+	{335, 1, &rule22},+	{336, 1, &rule21},+	{337, 1, &rule22},+	{338, 1, &rule21},+	{339, 1, &rule22},+	{340, 1, &rule21},+	{341, 1, &rule22},+	{342, 1, &rule21},+	{343, 1, &rule22},+	{344, 1, &rule21},+	{345, 1, &rule22},+	{346, 1, &rule21},+	{347, 1, &rule22},+	{348, 1, &rule21},+	{349, 1, &rule22},+	{350, 1, &rule21},+	{351, 1, &rule22},+	{352, 1, &rule21},+	{353, 1, &rule22},+	{354, 1, &rule21},+	{355, 1, &rule22},+	{356, 1, &rule21},+	{357, 1, &rule22},+	{358, 1, &rule21},+	{359, 1, &rule22},+	{360, 1, &rule21},+	{361, 1, &rule22},+	{362, 1, &rule21},+	{363, 1, &rule22},+	{364, 1, &rule21},+	{365, 1, &rule22},+	{366, 1, &rule21},+	{367, 1, &rule22},+	{368, 1, &rule21},+	{369, 1, &rule22},+	{370, 1, &rule21},+	{371, 1, &rule22},+	{372, 1, &rule21},+	{373, 1, &rule22},+	{374, 1, &rule21},+	{375, 1, &rule22},+	{376, 1, &rule25},+	{377, 1, &rule21},+	{378, 1, &rule22},+	{379, 1, &rule21},+	{380, 1, &rule22},+	{381, 1, &rule21},+	{382, 1, &rule22},+	{383, 1, &rule26},+	{384, 1, &rule27},+	{385, 1, &rule28},+	{386, 1, &rule21},+	{387, 1, &rule22},+	{388, 1, &rule21},+	{389, 1, &rule22},+	{390, 1, &rule29},+	{391, 1, &rule21},+	{392, 1, &rule22},+	{393, 2, &rule30},+	{395, 1, &rule21},+	{396, 1, &rule22},+	{398, 1, &rule31},+	{399, 1, &rule32},+	{400, 1, &rule33},+	{401, 1, &rule21},+	{402, 1, &rule22},+	{403, 1, &rule30},+	{404, 1, &rule34},+	{405, 1, &rule35},+	{406, 1, &rule36},+	{407, 1, &rule37},+	{408, 1, &rule21},+	{409, 1, &rule22},+	{410, 1, &rule38},+	{412, 1, &rule36},+	{413, 1, &rule39},+	{414, 1, &rule40},+	{415, 1, &rule41},+	{416, 1, &rule21},+	{417, 1, &rule22},+	{418, 1, &rule21},+	{419, 1, &rule22},+	{420, 1, &rule21},+	{421, 1, &rule22},+	{422, 1, &rule42},+	{423, 1, &rule21},+	{424, 1, &rule22},+	{425, 1, &rule42},+	{428, 1, &rule21},+	{429, 1, &rule22},+	{430, 1, &rule42},+	{431, 1, &rule21},+	{432, 1, &rule22},+	{433, 2, &rule43},+	{435, 1, &rule21},+	{436, 1, &rule22},+	{437, 1, &rule21},+	{438, 1, &rule22},+	{439, 1, &rule44},+	{440, 1, &rule21},+	{441, 1, &rule22},+	{444, 1, &rule21},+	{445, 1, &rule22},+	{447, 1, &rule46},+	{452, 1, &rule47},+	{453, 1, &rule48},+	{454, 1, &rule49},+	{455, 1, &rule47},+	{456, 1, &rule48},+	{457, 1, &rule49},+	{458, 1, &rule47},+	{459, 1, &rule48},+	{460, 1, &rule49},+	{461, 1, &rule21},+	{462, 1, &rule22},+	{463, 1, &rule21},+	{464, 1, &rule22},+	{465, 1, &rule21},+	{466, 1, &rule22},+	{467, 1, &rule21},+	{468, 1, &rule22},+	{469, 1, &rule21},+	{470, 1, &rule22},+	{471, 1, &rule21},+	{472, 1, &rule22},+	{473, 1, &rule21},+	{474, 1, &rule22},+	{475, 1, &rule21},+	{476, 1, &rule22},+	{477, 1, &rule50},+	{478, 1, &rule21},+	{479, 1, &rule22},+	{480, 1, &rule21},+	{481, 1, &rule22},+	{482, 1, &rule21},+	{483, 1, &rule22},+	{484, 1, &rule21},+	{485, 1, &rule22},+	{486, 1, &rule21},+	{487, 1, &rule22},+	{488, 1, &rule21},+	{489, 1, &rule22},+	{490, 1, &rule21},+	{491, 1, &rule22},+	{492, 1, &rule21},+	{493, 1, &rule22},+	{494, 1, &rule21},+	{495, 1, &rule22},+	{497, 1, &rule47},+	{498, 1, &rule48},+	{499, 1, &rule49},+	{500, 1, &rule21},+	{501, 1, &rule22},+	{502, 1, &rule51},+	{503, 1, &rule52},+	{504, 1, &rule21},+	{505, 1, &rule22},+	{506, 1, &rule21},+	{507, 1, &rule22},+	{508, 1, &rule21},+	{509, 1, &rule22},+	{510, 1, &rule21},+	{511, 1, &rule22},+	{512, 1, &rule21},+	{513, 1, &rule22},+	{514, 1, &rule21},+	{515, 1, &rule22},+	{516, 1, &rule21},+	{517, 1, &rule22},+	{518, 1, &rule21},+	{519, 1, &rule22},+	{520, 1, &rule21},+	{521, 1, &rule22},+	{522, 1, &rule21},+	{523, 1, &rule22},+	{524, 1, &rule21},+	{525, 1, &rule22},+	{526, 1, &rule21},+	{527, 1, &rule22},+	{528, 1, &rule21},+	{529, 1, &rule22},+	{530, 1, &rule21},+	{531, 1, &rule22},+	{532, 1, &rule21},+	{533, 1, &rule22},+	{534, 1, &rule21},+	{535, 1, &rule22},+	{536, 1, &rule21},+	{537, 1, &rule22},+	{538, 1, &rule21},+	{539, 1, &rule22},+	{540, 1, &rule21},+	{541, 1, &rule22},+	{542, 1, &rule21},+	{543, 1, &rule22},+	{544, 1, &rule53},+	{546, 1, &rule21},+	{547, 1, &rule22},+	{548, 1, &rule21},+	{549, 1, &rule22},+	{550, 1, &rule21},+	{551, 1, &rule22},+	{552, 1, &rule21},+	{553, 1, &rule22},+	{554, 1, &rule21},+	{555, 1, &rule22},+	{556, 1, &rule21},+	{557, 1, &rule22},+	{558, 1, &rule21},+	{559, 1, &rule22},+	{560, 1, &rule21},+	{561, 1, &rule22},+	{562, 1, &rule21},+	{563, 1, &rule22},+	{570, 1, &rule54},+	{571, 1, &rule21},+	{572, 1, &rule22},+	{573, 1, &rule55},+	{574, 1, &rule56},+	{575, 2, &rule57},+	{577, 1, &rule21},+	{578, 1, &rule22},+	{579, 1, &rule58},+	{580, 1, &rule59},+	{581, 1, &rule60},+	{582, 1, &rule21},+	{583, 1, &rule22},+	{584, 1, &rule21},+	{585, 1, &rule22},+	{586, 1, &rule21},+	{587, 1, &rule22},+	{588, 1, &rule21},+	{589, 1, &rule22},+	{590, 1, &rule21},+	{591, 1, &rule22},+	{592, 1, &rule61},+	{593, 1, &rule62},+	{594, 1, &rule63},+	{595, 1, &rule64},+	{596, 1, &rule65},+	{598, 2, &rule66},+	{601, 1, &rule67},+	{603, 1, &rule68},+	{608, 1, &rule66},+	{611, 1, &rule69},+	{613, 1, &rule70},+	{616, 1, &rule71},+	{617, 1, &rule72},+	{619, 1, &rule73},+	{623, 1, &rule72},+	{625, 1, &rule74},+	{626, 1, &rule75},+	{629, 1, &rule76},+	{637, 1, &rule77},+	{640, 1, &rule78},+	{643, 1, &rule78},+	{648, 1, &rule78},+	{649, 1, &rule79},+	{650, 2, &rule80},+	{652, 1, &rule81},+	{658, 1, &rule82},+	{837, 1, &rule85},+	{880, 1, &rule21},+	{881, 1, &rule22},+	{882, 1, &rule21},+	{883, 1, &rule22},+	{886, 1, &rule21},+	{887, 1, &rule22},+	{891, 3, &rule40},+	{902, 1, &rule86},+	{904, 3, &rule87},+	{908, 1, &rule88},+	{910, 2, &rule89},+	{913, 17, &rule9},+	{931, 9, &rule9},+	{940, 1, &rule90},+	{941, 3, &rule91},+	{945, 17, &rule12},+	{962, 1, &rule92},+	{963, 9, &rule12},+	{972, 1, &rule93},+	{973, 2, &rule94},+	{975, 1, &rule95},+	{976, 1, &rule96},+	{977, 1, &rule97},+	{981, 1, &rule99},+	{982, 1, &rule100},+	{983, 1, &rule101},+	{984, 1, &rule21},+	{985, 1, &rule22},+	{986, 1, &rule21},+	{987, 1, &rule22},+	{988, 1, &rule21},+	{989, 1, &rule22},+	{990, 1, &rule21},+	{991, 1, &rule22},+	{992, 1, &rule21},+	{993, 1, &rule22},+	{994, 1, &rule21},+	{995, 1, &rule22},+	{996, 1, &rule21},+	{997, 1, &rule22},+	{998, 1, &rule21},+	{999, 1, &rule22},+	{1000, 1, &rule21},+	{1001, 1, &rule22},+	{1002, 1, &rule21},+	{1003, 1, &rule22},+	{1004, 1, &rule21},+	{1005, 1, &rule22},+	{1006, 1, &rule21},+	{1007, 1, &rule22},+	{1008, 1, &rule102},+	{1009, 1, &rule103},+	{1010, 1, &rule104},+	{1012, 1, &rule105},+	{1013, 1, &rule106},+	{1015, 1, &rule21},+	{1016, 1, &rule22},+	{1017, 1, &rule107},+	{1018, 1, &rule21},+	{1019, 1, &rule22},+	{1021, 3, &rule53},+	{1024, 16, &rule108},+	{1040, 32, &rule9},+	{1072, 32, &rule12},+	{1104, 16, &rule103},+	{1120, 1, &rule21},+	{1121, 1, &rule22},+	{1122, 1, &rule21},+	{1123, 1, &rule22},+	{1124, 1, &rule21},+	{1125, 1, &rule22},+	{1126, 1, &rule21},+	{1127, 1, &rule22},+	{1128, 1, &rule21},+	{1129, 1, &rule22},+	{1130, 1, &rule21},+	{1131, 1, &rule22},+	{1132, 1, &rule21},+	{1133, 1, &rule22},+	{1134, 1, &rule21},+	{1135, 1, &rule22},+	{1136, 1, &rule21},+	{1137, 1, &rule22},+	{1138, 1, &rule21},+	{1139, 1, &rule22},+	{1140, 1, &rule21},+	{1141, 1, &rule22},+	{1142, 1, &rule21},+	{1143, 1, &rule22},+	{1144, 1, &rule21},+	{1145, 1, &rule22},+	{1146, 1, &rule21},+	{1147, 1, &rule22},+	{1148, 1, &rule21},+	{1149, 1, &rule22},+	{1150, 1, &rule21},+	{1151, 1, &rule22},+	{1152, 1, &rule21},+	{1153, 1, &rule22},+	{1162, 1, &rule21},+	{1163, 1, &rule22},+	{1164, 1, &rule21},+	{1165, 1, &rule22},+	{1166, 1, &rule21},+	{1167, 1, &rule22},+	{1168, 1, &rule21},+	{1169, 1, &rule22},+	{1170, 1, &rule21},+	{1171, 1, &rule22},+	{1172, 1, &rule21},+	{1173, 1, &rule22},+	{1174, 1, &rule21},+	{1175, 1, &rule22},+	{1176, 1, &rule21},+	{1177, 1, &rule22},+	{1178, 1, &rule21},+	{1179, 1, &rule22},+	{1180, 1, &rule21},+	{1181, 1, &rule22},+	{1182, 1, &rule21},+	{1183, 1, &rule22},+	{1184, 1, &rule21},+	{1185, 1, &rule22},+	{1186, 1, &rule21},+	{1187, 1, &rule22},+	{1188, 1, &rule21},+	{1189, 1, &rule22},+	{1190, 1, &rule21},+	{1191, 1, &rule22},+	{1192, 1, &rule21},+	{1193, 1, &rule22},+	{1194, 1, &rule21},+	{1195, 1, &rule22},+	{1196, 1, &rule21},+	{1197, 1, &rule22},+	{1198, 1, &rule21},+	{1199, 1, &rule22},+	{1200, 1, &rule21},+	{1201, 1, &rule22},+	{1202, 1, &rule21},+	{1203, 1, &rule22},+	{1204, 1, &rule21},+	{1205, 1, &rule22},+	{1206, 1, &rule21},+	{1207, 1, &rule22},+	{1208, 1, &rule21},+	{1209, 1, &rule22},+	{1210, 1, &rule21},+	{1211, 1, &rule22},+	{1212, 1, &rule21},+	{1213, 1, &rule22},+	{1214, 1, &rule21},+	{1215, 1, &rule22},+	{1216, 1, &rule110},+	{1217, 1, &rule21},+	{1218, 1, &rule22},+	{1219, 1, &rule21},+	{1220, 1, &rule22},+	{1221, 1, &rule21},+	{1222, 1, &rule22},+	{1223, 1, &rule21},+	{1224, 1, &rule22},+	{1225, 1, &rule21},+	{1226, 1, &rule22},+	{1227, 1, &rule21},+	{1228, 1, &rule22},+	{1229, 1, &rule21},+	{1230, 1, &rule22},+	{1231, 1, &rule111},+	{1232, 1, &rule21},+	{1233, 1, &rule22},+	{1234, 1, &rule21},+	{1235, 1, &rule22},+	{1236, 1, &rule21},+	{1237, 1, &rule22},+	{1238, 1, &rule21},+	{1239, 1, &rule22},+	{1240, 1, &rule21},+	{1241, 1, &rule22},+	{1242, 1, &rule21},+	{1243, 1, &rule22},+	{1244, 1, &rule21},+	{1245, 1, &rule22},+	{1246, 1, &rule21},+	{1247, 1, &rule22},+	{1248, 1, &rule21},+	{1249, 1, &rule22},+	{1250, 1, &rule21},+	{1251, 1, &rule22},+	{1252, 1, &rule21},+	{1253, 1, &rule22},+	{1254, 1, &rule21},+	{1255, 1, &rule22},+	{1256, 1, &rule21},+	{1257, 1, &rule22},+	{1258, 1, &rule21},+	{1259, 1, &rule22},+	{1260, 1, &rule21},+	{1261, 1, &rule22},+	{1262, 1, &rule21},+	{1263, 1, &rule22},+	{1264, 1, &rule21},+	{1265, 1, &rule22},+	{1266, 1, &rule21},+	{1267, 1, &rule22},+	{1268, 1, &rule21},+	{1269, 1, &rule22},+	{1270, 1, &rule21},+	{1271, 1, &rule22},+	{1272, 1, &rule21},+	{1273, 1, &rule22},+	{1274, 1, &rule21},+	{1275, 1, &rule22},+	{1276, 1, &rule21},+	{1277, 1, &rule22},+	{1278, 1, &rule21},+	{1279, 1, &rule22},+	{1280, 1, &rule21},+	{1281, 1, &rule22},+	{1282, 1, &rule21},+	{1283, 1, &rule22},+	{1284, 1, &rule21},+	{1285, 1, &rule22},+	{1286, 1, &rule21},+	{1287, 1, &rule22},+	{1288, 1, &rule21},+	{1289, 1, &rule22},+	{1290, 1, &rule21},+	{1291, 1, &rule22},+	{1292, 1, &rule21},+	{1293, 1, &rule22},+	{1294, 1, &rule21},+	{1295, 1, &rule22},+	{1296, 1, &rule21},+	{1297, 1, &rule22},+	{1298, 1, &rule21},+	{1299, 1, &rule22},+	{1300, 1, &rule21},+	{1301, 1, &rule22},+	{1302, 1, &rule21},+	{1303, 1, &rule22},+	{1304, 1, &rule21},+	{1305, 1, &rule22},+	{1306, 1, &rule21},+	{1307, 1, &rule22},+	{1308, 1, &rule21},+	{1309, 1, &rule22},+	{1310, 1, &rule21},+	{1311, 1, &rule22},+	{1312, 1, &rule21},+	{1313, 1, &rule22},+	{1314, 1, &rule21},+	{1315, 1, &rule22},+	{1316, 1, &rule21},+	{1317, 1, &rule22},+	{1318, 1, &rule21},+	{1319, 1, &rule22},+	{1329, 38, &rule112},+	{1377, 38, &rule113},+	{4256, 38, &rule115},+	{7545, 1, &rule117},+	{7549, 1, &rule118},+	{7680, 1, &rule21},+	{7681, 1, &rule22},+	{7682, 1, &rule21},+	{7683, 1, &rule22},+	{7684, 1, &rule21},+	{7685, 1, &rule22},+	{7686, 1, &rule21},+	{7687, 1, &rule22},+	{7688, 1, &rule21},+	{7689, 1, &rule22},+	{7690, 1, &rule21},+	{7691, 1, &rule22},+	{7692, 1, &rule21},+	{7693, 1, &rule22},+	{7694, 1, &rule21},+	{7695, 1, &rule22},+	{7696, 1, &rule21},+	{7697, 1, &rule22},+	{7698, 1, &rule21},+	{7699, 1, &rule22},+	{7700, 1, &rule21},+	{7701, 1, &rule22},+	{7702, 1, &rule21},+	{7703, 1, &rule22},+	{7704, 1, &rule21},+	{7705, 1, &rule22},+	{7706, 1, &rule21},+	{7707, 1, &rule22},+	{7708, 1, &rule21},+	{7709, 1, &rule22},+	{7710, 1, &rule21},+	{7711, 1, &rule22},+	{7712, 1, &rule21},+	{7713, 1, &rule22},+	{7714, 1, &rule21},+	{7715, 1, &rule22},+	{7716, 1, &rule21},+	{7717, 1, &rule22},+	{7718, 1, &rule21},+	{7719, 1, &rule22},+	{7720, 1, &rule21},+	{7721, 1, &rule22},+	{7722, 1, &rule21},+	{7723, 1, &rule22},+	{7724, 1, &rule21},+	{7725, 1, &rule22},+	{7726, 1, &rule21},+	{7727, 1, &rule22},+	{7728, 1, &rule21},+	{7729, 1, &rule22},+	{7730, 1, &rule21},+	{7731, 1, &rule22},+	{7732, 1, &rule21},+	{7733, 1, &rule22},+	{7734, 1, &rule21},+	{7735, 1, &rule22},+	{7736, 1, &rule21},+	{7737, 1, &rule22},+	{7738, 1, &rule21},+	{7739, 1, &rule22},+	{7740, 1, &rule21},+	{7741, 1, &rule22},+	{7742, 1, &rule21},+	{7743, 1, &rule22},+	{7744, 1, &rule21},+	{7745, 1, &rule22},+	{7746, 1, &rule21},+	{7747, 1, &rule22},+	{7748, 1, &rule21},+	{7749, 1, &rule22},+	{7750, 1, &rule21},+	{7751, 1, &rule22},+	{7752, 1, &rule21},+	{7753, 1, &rule22},+	{7754, 1, &rule21},+	{7755, 1, &rule22},+	{7756, 1, &rule21},+	{7757, 1, &rule22},+	{7758, 1, &rule21},+	{7759, 1, &rule22},+	{7760, 1, &rule21},+	{7761, 1, &rule22},+	{7762, 1, &rule21},+	{7763, 1, &rule22},+	{7764, 1, &rule21},+	{7765, 1, &rule22},+	{7766, 1, &rule21},+	{7767, 1, &rule22},+	{7768, 1, &rule21},+	{7769, 1, &rule22},+	{7770, 1, &rule21},+	{7771, 1, &rule22},+	{7772, 1, &rule21},+	{7773, 1, &rule22},+	{7774, 1, &rule21},+	{7775, 1, &rule22},+	{7776, 1, &rule21},+	{7777, 1, &rule22},+	{7778, 1, &rule21},+	{7779, 1, &rule22},+	{7780, 1, &rule21},+	{7781, 1, &rule22},+	{7782, 1, &rule21},+	{7783, 1, &rule22},+	{7784, 1, &rule21},+	{7785, 1, &rule22},+	{7786, 1, &rule21},+	{7787, 1, &rule22},+	{7788, 1, &rule21},+	{7789, 1, &rule22},+	{7790, 1, &rule21},+	{7791, 1, &rule22},+	{7792, 1, &rule21},+	{7793, 1, &rule22},+	{7794, 1, &rule21},+	{7795, 1, &rule22},+	{7796, 1, &rule21},+	{7797, 1, &rule22},+	{7798, 1, &rule21},+	{7799, 1, &rule22},+	{7800, 1, &rule21},+	{7801, 1, &rule22},+	{7802, 1, &rule21},+	{7803, 1, &rule22},+	{7804, 1, &rule21},+	{7805, 1, &rule22},+	{7806, 1, &rule21},+	{7807, 1, &rule22},+	{7808, 1, &rule21},+	{7809, 1, &rule22},+	{7810, 1, &rule21},+	{7811, 1, &rule22},+	{7812, 1, &rule21},+	{7813, 1, &rule22},+	{7814, 1, &rule21},+	{7815, 1, &rule22},+	{7816, 1, &rule21},+	{7817, 1, &rule22},+	{7818, 1, &rule21},+	{7819, 1, &rule22},+	{7820, 1, &rule21},+	{7821, 1, &rule22},+	{7822, 1, &rule21},+	{7823, 1, &rule22},+	{7824, 1, &rule21},+	{7825, 1, &rule22},+	{7826, 1, &rule21},+	{7827, 1, &rule22},+	{7828, 1, &rule21},+	{7829, 1, &rule22},+	{7835, 1, &rule119},+	{7838, 1, &rule120},+	{7840, 1, &rule21},+	{7841, 1, &rule22},+	{7842, 1, &rule21},+	{7843, 1, &rule22},+	{7844, 1, &rule21},+	{7845, 1, &rule22},+	{7846, 1, &rule21},+	{7847, 1, &rule22},+	{7848, 1, &rule21},+	{7849, 1, &rule22},+	{7850, 1, &rule21},+	{7851, 1, &rule22},+	{7852, 1, &rule21},+	{7853, 1, &rule22},+	{7854, 1, &rule21},+	{7855, 1, &rule22},+	{7856, 1, &rule21},+	{7857, 1, &rule22},+	{7858, 1, &rule21},+	{7859, 1, &rule22},+	{7860, 1, &rule21},+	{7861, 1, &rule22},+	{7862, 1, &rule21},+	{7863, 1, &rule22},+	{7864, 1, &rule21},+	{7865, 1, &rule22},+	{7866, 1, &rule21},+	{7867, 1, &rule22},+	{7868, 1, &rule21},+	{7869, 1, &rule22},+	{7870, 1, &rule21},+	{7871, 1, &rule22},+	{7872, 1, &rule21},+	{7873, 1, &rule22},+	{7874, 1, &rule21},+	{7875, 1, &rule22},+	{7876, 1, &rule21},+	{7877, 1, &rule22},+	{7878, 1, &rule21},+	{7879, 1, &rule22},+	{7880, 1, &rule21},+	{7881, 1, &rule22},+	{7882, 1, &rule21},+	{7883, 1, &rule22},+	{7884, 1, &rule21},+	{7885, 1, &rule22},+	{7886, 1, &rule21},+	{7887, 1, &rule22},+	{7888, 1, &rule21},+	{7889, 1, &rule22},+	{7890, 1, &rule21},+	{7891, 1, &rule22},+	{7892, 1, &rule21},+	{7893, 1, &rule22},+	{7894, 1, &rule21},+	{7895, 1, &rule22},+	{7896, 1, &rule21},+	{7897, 1, &rule22},+	{7898, 1, &rule21},+	{7899, 1, &rule22},+	{7900, 1, &rule21},+	{7901, 1, &rule22},+	{7902, 1, &rule21},+	{7903, 1, &rule22},+	{7904, 1, &rule21},+	{7905, 1, &rule22},+	{7906, 1, &rule21},+	{7907, 1, &rule22},+	{7908, 1, &rule21},+	{7909, 1, &rule22},+	{7910, 1, &rule21},+	{7911, 1, &rule22},+	{7912, 1, &rule21},+	{7913, 1, &rule22},+	{7914, 1, &rule21},+	{7915, 1, &rule22},+	{7916, 1, &rule21},+	{7917, 1, &rule22},+	{7918, 1, &rule21},+	{7919, 1, &rule22},+	{7920, 1, &rule21},+	{7921, 1, &rule22},+	{7922, 1, &rule21},+	{7923, 1, &rule22},+	{7924, 1, &rule21},+	{7925, 1, &rule22},+	{7926, 1, &rule21},+	{7927, 1, &rule22},+	{7928, 1, &rule21},+	{7929, 1, &rule22},+	{7930, 1, &rule21},+	{7931, 1, &rule22},+	{7932, 1, &rule21},+	{7933, 1, &rule22},+	{7934, 1, &rule21},+	{7935, 1, &rule22},+	{7936, 8, &rule121},+	{7944, 8, &rule122},+	{7952, 6, &rule121},+	{7960, 6, &rule122},+	{7968, 8, &rule121},+	{7976, 8, &rule122},+	{7984, 8, &rule121},+	{7992, 8, &rule122},+	{8000, 6, &rule121},+	{8008, 6, &rule122},+	{8017, 1, &rule121},+	{8019, 1, &rule121},+	{8021, 1, &rule121},+	{8023, 1, &rule121},+	{8025, 1, &rule122},+	{8027, 1, &rule122},+	{8029, 1, &rule122},+	{8031, 1, &rule122},+	{8032, 8, &rule121},+	{8040, 8, &rule122},+	{8048, 2, &rule123},+	{8050, 4, &rule124},+	{8054, 2, &rule125},+	{8056, 2, &rule126},+	{8058, 2, &rule127},+	{8060, 2, &rule128},+	{8064, 8, &rule121},+	{8072, 8, &rule129},+	{8080, 8, &rule121},+	{8088, 8, &rule129},+	{8096, 8, &rule121},+	{8104, 8, &rule129},+	{8112, 2, &rule121},+	{8115, 1, &rule130},+	{8120, 2, &rule122},+	{8122, 2, &rule131},+	{8124, 1, &rule132},+	{8126, 1, &rule133},+	{8131, 1, &rule130},+	{8136, 4, &rule134},+	{8140, 1, &rule132},+	{8144, 2, &rule121},+	{8152, 2, &rule122},+	{8154, 2, &rule135},+	{8160, 2, &rule121},+	{8165, 1, &rule104},+	{8168, 2, &rule122},+	{8170, 2, &rule136},+	{8172, 1, &rule107},+	{8179, 1, &rule130},+	{8184, 2, &rule137},+	{8186, 2, &rule138},+	{8188, 1, &rule132},+	{8486, 1, &rule141},+	{8490, 1, &rule142},+	{8491, 1, &rule143},+	{8498, 1, &rule144},+	{8526, 1, &rule145},+	{8544, 16, &rule146},+	{8560, 16, &rule147},+	{8579, 1, &rule21},+	{8580, 1, &rule22},+	{9398, 26, &rule148},+	{9424, 26, &rule149},+	{11264, 47, &rule112},+	{11312, 47, &rule113},+	{11360, 1, &rule21},+	{11361, 1, &rule22},+	{11362, 1, &rule150},+	{11363, 1, &rule151},+	{11364, 1, &rule152},+	{11365, 1, &rule153},+	{11366, 1, &rule154},+	{11367, 1, &rule21},+	{11368, 1, &rule22},+	{11369, 1, &rule21},+	{11370, 1, &rule22},+	{11371, 1, &rule21},+	{11372, 1, &rule22},+	{11373, 1, &rule155},+	{11374, 1, &rule156},+	{11375, 1, &rule157},+	{11376, 1, &rule158},+	{11378, 1, &rule21},+	{11379, 1, &rule22},+	{11381, 1, &rule21},+	{11382, 1, &rule22},+	{11390, 2, &rule159},+	{11392, 1, &rule21},+	{11393, 1, &rule22},+	{11394, 1, &rule21},+	{11395, 1, &rule22},+	{11396, 1, &rule21},+	{11397, 1, &rule22},+	{11398, 1, &rule21},+	{11399, 1, &rule22},+	{11400, 1, &rule21},+	{11401, 1, &rule22},+	{11402, 1, &rule21},+	{11403, 1, &rule22},+	{11404, 1, &rule21},+	{11405, 1, &rule22},+	{11406, 1, &rule21},+	{11407, 1, &rule22},+	{11408, 1, &rule21},+	{11409, 1, &rule22},+	{11410, 1, &rule21},+	{11411, 1, &rule22},+	{11412, 1, &rule21},+	{11413, 1, &rule22},+	{11414, 1, &rule21},+	{11415, 1, &rule22},+	{11416, 1, &rule21},+	{11417, 1, &rule22},+	{11418, 1, &rule21},+	{11419, 1, &rule22},+	{11420, 1, &rule21},+	{11421, 1, &rule22},+	{11422, 1, &rule21},+	{11423, 1, &rule22},+	{11424, 1, &rule21},+	{11425, 1, &rule22},+	{11426, 1, &rule21},+	{11427, 1, &rule22},+	{11428, 1, &rule21},+	{11429, 1, &rule22},+	{11430, 1, &rule21},+	{11431, 1, &rule22},+	{11432, 1, &rule21},+	{11433, 1, &rule22},+	{11434, 1, &rule21},+	{11435, 1, &rule22},+	{11436, 1, &rule21},+	{11437, 1, &rule22},+	{11438, 1, &rule21},+	{11439, 1, &rule22},+	{11440, 1, &rule21},+	{11441, 1, &rule22},+	{11442, 1, &rule21},+	{11443, 1, &rule22},+	{11444, 1, &rule21},+	{11445, 1, &rule22},+	{11446, 1, &rule21},+	{11447, 1, &rule22},+	{11448, 1, &rule21},+	{11449, 1, &rule22},+	{11450, 1, &rule21},+	{11451, 1, &rule22},+	{11452, 1, &rule21},+	{11453, 1, &rule22},+	{11454, 1, &rule21},+	{11455, 1, &rule22},+	{11456, 1, &rule21},+	{11457, 1, &rule22},+	{11458, 1, &rule21},+	{11459, 1, &rule22},+	{11460, 1, &rule21},+	{11461, 1, &rule22},+	{11462, 1, &rule21},+	{11463, 1, &rule22},+	{11464, 1, &rule21},+	{11465, 1, &rule22},+	{11466, 1, &rule21},+	{11467, 1, &rule22},+	{11468, 1, &rule21},+	{11469, 1, &rule22},+	{11470, 1, &rule21},+	{11471, 1, &rule22},+	{11472, 1, &rule21},+	{11473, 1, &rule22},+	{11474, 1, &rule21},+	{11475, 1, &rule22},+	{11476, 1, &rule21},+	{11477, 1, &rule22},+	{11478, 1, &rule21},+	{11479, 1, &rule22},+	{11480, 1, &rule21},+	{11481, 1, &rule22},+	{11482, 1, &rule21},+	{11483, 1, &rule22},+	{11484, 1, &rule21},+	{11485, 1, &rule22},+	{11486, 1, &rule21},+	{11487, 1, &rule22},+	{11488, 1, &rule21},+	{11489, 1, &rule22},+	{11490, 1, &rule21},+	{11491, 1, &rule22},+	{11499, 1, &rule21},+	{11500, 1, &rule22},+	{11501, 1, &rule21},+	{11502, 1, &rule22},+	{11520, 38, &rule160},+	{42560, 1, &rule21},+	{42561, 1, &rule22},+	{42562, 1, &rule21},+	{42563, 1, &rule22},+	{42564, 1, &rule21},+	{42565, 1, &rule22},+	{42566, 1, &rule21},+	{42567, 1, &rule22},+	{42568, 1, &rule21},+	{42569, 1, &rule22},+	{42570, 1, &rule21},+	{42571, 1, &rule22},+	{42572, 1, &rule21},+	{42573, 1, &rule22},+	{42574, 1, &rule21},+	{42575, 1, &rule22},+	{42576, 1, &rule21},+	{42577, 1, &rule22},+	{42578, 1, &rule21},+	{42579, 1, &rule22},+	{42580, 1, &rule21},+	{42581, 1, &rule22},+	{42582, 1, &rule21},+	{42583, 1, &rule22},+	{42584, 1, &rule21},+	{42585, 1, &rule22},+	{42586, 1, &rule21},+	{42587, 1, &rule22},+	{42588, 1, &rule21},+	{42589, 1, &rule22},+	{42590, 1, &rule21},+	{42591, 1, &rule22},+	{42592, 1, &rule21},+	{42593, 1, &rule22},+	{42594, 1, &rule21},+	{42595, 1, &rule22},+	{42596, 1, &rule21},+	{42597, 1, &rule22},+	{42598, 1, &rule21},+	{42599, 1, &rule22},+	{42600, 1, &rule21},+	{42601, 1, &rule22},+	{42602, 1, &rule21},+	{42603, 1, &rule22},+	{42604, 1, &rule21},+	{42605, 1, &rule22},+	{42624, 1, &rule21},+	{42625, 1, &rule22},+	{42626, 1, &rule21},+	{42627, 1, &rule22},+	{42628, 1, &rule21},+	{42629, 1, &rule22},+	{42630, 1, &rule21},+	{42631, 1, &rule22},+	{42632, 1, &rule21},+	{42633, 1, &rule22},+	{42634, 1, &rule21},+	{42635, 1, &rule22},+	{42636, 1, &rule21},+	{42637, 1, &rule22},+	{42638, 1, &rule21},+	{42639, 1, &rule22},+	{42640, 1, &rule21},+	{42641, 1, &rule22},+	{42642, 1, &rule21},+	{42643, 1, &rule22},+	{42644, 1, &rule21},+	{42645, 1, &rule22},+	{42646, 1, &rule21},+	{42647, 1, &rule22},+	{42786, 1, &rule21},+	{42787, 1, &rule22},+	{42788, 1, &rule21},+	{42789, 1, &rule22},+	{42790, 1, &rule21},+	{42791, 1, &rule22},+	{42792, 1, &rule21},+	{42793, 1, &rule22},+	{42794, 1, &rule21},+	{42795, 1, &rule22},+	{42796, 1, &rule21},+	{42797, 1, &rule22},+	{42798, 1, &rule21},+	{42799, 1, &rule22},+	{42802, 1, &rule21},+	{42803, 1, &rule22},+	{42804, 1, &rule21},+	{42805, 1, &rule22},+	{42806, 1, &rule21},+	{42807, 1, &rule22},+	{42808, 1, &rule21},+	{42809, 1, &rule22},+	{42810, 1, &rule21},+	{42811, 1, &rule22},+	{42812, 1, &rule21},+	{42813, 1, &rule22},+	{42814, 1, &rule21},+	{42815, 1, &rule22},+	{42816, 1, &rule21},+	{42817, 1, &rule22},+	{42818, 1, &rule21},+	{42819, 1, &rule22},+	{42820, 1, &rule21},+	{42821, 1, &rule22},+	{42822, 1, &rule21},+	{42823, 1, &rule22},+	{42824, 1, &rule21},+	{42825, 1, &rule22},+	{42826, 1, &rule21},+	{42827, 1, &rule22},+	{42828, 1, &rule21},+	{42829, 1, &rule22},+	{42830, 1, &rule21},+	{42831, 1, &rule22},+	{42832, 1, &rule21},+	{42833, 1, &rule22},+	{42834, 1, &rule21},+	{42835, 1, &rule22},+	{42836, 1, &rule21},+	{42837, 1, &rule22},+	{42838, 1, &rule21},+	{42839, 1, &rule22},+	{42840, 1, &rule21},+	{42841, 1, &rule22},+	{42842, 1, &rule21},+	{42843, 1, &rule22},+	{42844, 1, &rule21},+	{42845, 1, &rule22},+	{42846, 1, &rule21},+	{42847, 1, &rule22},+	{42848, 1, &rule21},+	{42849, 1, &rule22},+	{42850, 1, &rule21},+	{42851, 1, &rule22},+	{42852, 1, &rule21},+	{42853, 1, &rule22},+	{42854, 1, &rule21},+	{42855, 1, &rule22},+	{42856, 1, &rule21},+	{42857, 1, &rule22},+	{42858, 1, &rule21},+	{42859, 1, &rule22},+	{42860, 1, &rule21},+	{42861, 1, &rule22},+	{42862, 1, &rule21},+	{42863, 1, &rule22},+	{42873, 1, &rule21},+	{42874, 1, &rule22},+	{42875, 1, &rule21},+	{42876, 1, &rule22},+	{42877, 1, &rule161},+	{42878, 1, &rule21},+	{42879, 1, &rule22},+	{42880, 1, &rule21},+	{42881, 1, &rule22},+	{42882, 1, &rule21},+	{42883, 1, &rule22},+	{42884, 1, &rule21},+	{42885, 1, &rule22},+	{42886, 1, &rule21},+	{42887, 1, &rule22},+	{42891, 1, &rule21},+	{42892, 1, &rule22},+	{42893, 1, &rule162},+	{42896, 1, &rule21},+	{42897, 1, &rule22},+	{42912, 1, &rule21},+	{42913, 1, &rule22},+	{42914, 1, &rule21},+	{42915, 1, &rule22},+	{42916, 1, &rule21},+	{42917, 1, &rule22},+	{42918, 1, &rule21},+	{42919, 1, &rule22},+	{42920, 1, &rule21},+	{42921, 1, &rule22},+	{65313, 26, &rule9},+	{65345, 26, &rule12},+	{66560, 40, &rule165},+	{66600, 40, &rule166} }; static const struct _charblock_ spacechars[]={ 	{32, 1, &rule1},
+ cbits/md5.c view
@@ -0,0 +1,238 @@+/*+ * This code implements the MD5 message-digest algorithm.+ * The algorithm is due to Ron Rivest.  This code was+ * written by Colin Plumb in 1993, no copyright is claimed.+ * This code is in the public domain; do with it what you wish.+ *+ * Equivalent code is available from RSA Data Security, Inc.+ * This code has been tested against that, and is equivalent,+ * except that you don't need to include two pages of legalese+ * with every copy.+ *+ * To compute the message digest of a chunk of bytes, declare an+ * MD5Context structure, pass it to MD5Init, call MD5Update as+ * needed on buffers full of bytes, and then call MD5Final, which+ * will fill a supplied 16-byte array with the digest.+ */++#include "HsFFI.h"+#include "md5.h"+#include <string.h>++void MD5Init(struct MD5Context *context);+void MD5Update(struct MD5Context *context, byte const *buf, int len);+void MD5Final(byte digest[16], struct MD5Context *context);+void MD5Transform(word32 buf[4], word32 const in[16]);+++/*+ * Shuffle the bytes into little-endian order within words, as per the+ * MD5 spec.  Note: this code works regardless of the byte order.+ */+void+byteSwap(word32 *buf, unsigned words)+{+	byte *p = (byte *)buf;++	do {+		*buf++ = (word32)((unsigned)p[3] << 8 | p[2]) << 16 |+			((unsigned)p[1] << 8 | p[0]);+		p += 4;+	} while (--words);+}++/*+ * Start MD5 accumulation.  Set bit count to 0 and buffer to mysterious+ * initialization constants.+ */+void+MD5Init(struct MD5Context *ctx)+{+	ctx->buf[0] = 0x67452301;+	ctx->buf[1] = 0xefcdab89;+	ctx->buf[2] = 0x98badcfe;+	ctx->buf[3] = 0x10325476;++	ctx->bytes[0] = 0;+	ctx->bytes[1] = 0;+}++/*+ * Update context to reflect the concatenation of another buffer full+ * of bytes.+ */+void+MD5Update(struct MD5Context *ctx, byte const *buf, int len)+{+	word32 t;++	/* Update byte count */++	t = ctx->bytes[0];+	if ((ctx->bytes[0] = t + len) < t)+		ctx->bytes[1]++;	/* Carry from low to high */++	t = 64 - (t & 0x3f);	/* Space available in ctx->in (at least 1) */+	if ((unsigned)t > len) {+		memcpy((byte *)ctx->in + 64 - (unsigned)t, buf, len);+		return;+	}+	/* First chunk is an odd size */+	memcpy((byte *)ctx->in + 64 - (unsigned)t, buf, (unsigned)t);+	byteSwap(ctx->in, 16);+	MD5Transform(ctx->buf, ctx->in);+	buf += (unsigned)t;+	len -= (unsigned)t;++	/* Process data in 64-byte chunks */+	while (len >= 64) {+		memcpy(ctx->in, buf, 64);+		byteSwap(ctx->in, 16);+		MD5Transform(ctx->buf, ctx->in);+		buf += 64;+		len -= 64;+	}++	/* Handle any remaining bytes of data. */+	memcpy(ctx->in, buf, len);+}++/*+ * Final wrapup - pad to 64-byte boundary with the bit pattern + * 1 0* (64-bit count of bits processed, MSB-first)+ */+void+MD5Final(byte digest[16], struct MD5Context *ctx)+{+	int count = (int)(ctx->bytes[0] & 0x3f); /* Bytes in ctx->in */+	byte *p = (byte *)ctx->in + count;	/* First unused byte */++	/* Set the first char of padding to 0x80.  There is always room. */+	*p++ = 0x80;++	/* Bytes of padding needed to make 56 bytes (-8..55) */+	count = 56 - 1 - count;++	if (count < 0) {	/* Padding forces an extra block */+		memset(p, 0, count+8);+		byteSwap(ctx->in, 16);+		MD5Transform(ctx->buf, ctx->in);+		p = (byte *)ctx->in;+		count = 56;+	}+	memset(p, 0, count+8);+	byteSwap(ctx->in, 14);++	/* Append length in bits and transform */+	ctx->in[14] = ctx->bytes[0] << 3;+	ctx->in[15] = ctx->bytes[1] << 3 | ctx->bytes[0] >> 29;+	MD5Transform(ctx->buf, ctx->in);++	byteSwap(ctx->buf, 4);+	memcpy(digest, ctx->buf, 16);+	memset(ctx,0,sizeof(ctx));+}+++/* The four core functions - F1 is optimized somewhat */++/* #define F1(x, y, z) (x & y | ~x & z) */+#define F1(x, y, z) (z ^ (x & (y ^ z)))+#define F2(x, y, z) F1(z, x, y)+#define F3(x, y, z) (x ^ y ^ z)+#define F4(x, y, z) (y ^ (x | ~z))++/* This is the central step in the MD5 algorithm. */+#define MD5STEP(f,w,x,y,z,in,s) \+	 (w += f(x,y,z) + in, w = (w<<s | w>>(32-s)) + x)++/*+ * The core of the MD5 algorithm, this alters an existing MD5 hash to+ * reflect the addition of 16 longwords of new data.  MD5Update blocks+ * the data and converts bytes into longwords for this routine.+ */++void+MD5Transform(word32 buf[4], word32 const in[16])+{+	register word32 a, b, c, d;++	a = buf[0];+	b = buf[1];+	c = buf[2];+	d = buf[3];++	MD5STEP(F1, a, b, c, d, in[0] + 0xd76aa478, 7);+	MD5STEP(F1, d, a, b, c, in[1] + 0xe8c7b756, 12);+	MD5STEP(F1, c, d, a, b, in[2] + 0x242070db, 17);+	MD5STEP(F1, b, c, d, a, in[3] + 0xc1bdceee, 22);+	MD5STEP(F1, a, b, c, d, in[4] + 0xf57c0faf, 7);+	MD5STEP(F1, d, a, b, c, in[5] + 0x4787c62a, 12);+	MD5STEP(F1, c, d, a, b, in[6] + 0xa8304613, 17);+	MD5STEP(F1, b, c, d, a, in[7] + 0xfd469501, 22);+	MD5STEP(F1, a, b, c, d, in[8] + 0x698098d8, 7);+	MD5STEP(F1, d, a, b, c, in[9] + 0x8b44f7af, 12);+	MD5STEP(F1, c, d, a, b, in[10] + 0xffff5bb1, 17);+	MD5STEP(F1, b, c, d, a, in[11] + 0x895cd7be, 22);+	MD5STEP(F1, a, b, c, d, in[12] + 0x6b901122, 7);+	MD5STEP(F1, d, a, b, c, in[13] + 0xfd987193, 12);+	MD5STEP(F1, c, d, a, b, in[14] + 0xa679438e, 17);+	MD5STEP(F1, b, c, d, a, in[15] + 0x49b40821, 22);++	MD5STEP(F2, a, b, c, d, in[1] + 0xf61e2562, 5);+	MD5STEP(F2, d, a, b, c, in[6] + 0xc040b340, 9);+	MD5STEP(F2, c, d, a, b, in[11] + 0x265e5a51, 14);+	MD5STEP(F2, b, c, d, a, in[0] + 0xe9b6c7aa, 20);+	MD5STEP(F2, a, b, c, d, in[5] + 0xd62f105d, 5);+	MD5STEP(F2, d, a, b, c, in[10] + 0x02441453, 9);+	MD5STEP(F2, c, d, a, b, in[15] + 0xd8a1e681, 14);+	MD5STEP(F2, b, c, d, a, in[4] + 0xe7d3fbc8, 20);+	MD5STEP(F2, a, b, c, d, in[9] + 0x21e1cde6, 5);+	MD5STEP(F2, d, a, b, c, in[14] + 0xc33707d6, 9);+	MD5STEP(F2, c, d, a, b, in[3] + 0xf4d50d87, 14);+	MD5STEP(F2, b, c, d, a, in[8] + 0x455a14ed, 20);+	MD5STEP(F2, a, b, c, d, in[13] + 0xa9e3e905, 5);+	MD5STEP(F2, d, a, b, c, in[2] + 0xfcefa3f8, 9);+	MD5STEP(F2, c, d, a, b, in[7] + 0x676f02d9, 14);+	MD5STEP(F2, b, c, d, a, in[12] + 0x8d2a4c8a, 20);++	MD5STEP(F3, a, b, c, d, in[5] + 0xfffa3942, 4);+	MD5STEP(F3, d, a, b, c, in[8] + 0x8771f681, 11);+	MD5STEP(F3, c, d, a, b, in[11] + 0x6d9d6122, 16);+	MD5STEP(F3, b, c, d, a, in[14] + 0xfde5380c, 23);+	MD5STEP(F3, a, b, c, d, in[1] + 0xa4beea44, 4);+	MD5STEP(F3, d, a, b, c, in[4] + 0x4bdecfa9, 11);+	MD5STEP(F3, c, d, a, b, in[7] + 0xf6bb4b60, 16);+	MD5STEP(F3, b, c, d, a, in[10] + 0xbebfbc70, 23);+	MD5STEP(F3, a, b, c, d, in[13] + 0x289b7ec6, 4);+	MD5STEP(F3, d, a, b, c, in[0] + 0xeaa127fa, 11);+	MD5STEP(F3, c, d, a, b, in[3] + 0xd4ef3085, 16);+	MD5STEP(F3, b, c, d, a, in[6] + 0x04881d05, 23);+	MD5STEP(F3, a, b, c, d, in[9] + 0xd9d4d039, 4);+	MD5STEP(F3, d, a, b, c, in[12] + 0xe6db99e5, 11);+	MD5STEP(F3, c, d, a, b, in[15] + 0x1fa27cf8, 16);+	MD5STEP(F3, b, c, d, a, in[2] + 0xc4ac5665, 23);++	MD5STEP(F4, a, b, c, d, in[0] + 0xf4292244, 6);+	MD5STEP(F4, d, a, b, c, in[7] + 0x432aff97, 10);+	MD5STEP(F4, c, d, a, b, in[14] + 0xab9423a7, 15);+	MD5STEP(F4, b, c, d, a, in[5] + 0xfc93a039, 21);+	MD5STEP(F4, a, b, c, d, in[12] + 0x655b59c3, 6);+	MD5STEP(F4, d, a, b, c, in[3] + 0x8f0ccc92, 10);+	MD5STEP(F4, c, d, a, b, in[10] + 0xffeff47d, 15);+	MD5STEP(F4, b, c, d, a, in[1] + 0x85845dd1, 21);+	MD5STEP(F4, a, b, c, d, in[8] + 0x6fa87e4f, 6);+	MD5STEP(F4, d, a, b, c, in[15] + 0xfe2ce6e0, 10);+	MD5STEP(F4, c, d, a, b, in[6] + 0xa3014314, 15);+	MD5STEP(F4, b, c, d, a, in[13] + 0x4e0811a1, 21);+	MD5STEP(F4, a, b, c, d, in[4] + 0xf7537e82, 6);+	MD5STEP(F4, d, a, b, c, in[11] + 0xbd3af235, 10);+	MD5STEP(F4, c, d, a, b, in[2] + 0x2ad7d2bb, 15);+	MD5STEP(F4, b, c, d, a, in[9] + 0xeb86d391, 21);++	buf[0] += a;+	buf[1] += b;+	buf[2] += c;+	buf[3] += d;+}+
cbits/primFloat.c view
@@ -44,7 +44,7 @@ };  /*- +  To recap, here's the representation of a double precision  IEEE floating point number: @@ -106,7 +106,7 @@  /*  * 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@@ -115,7 +115,7 @@ isDoubleNaN(HsDouble d) {   union stg_ieee754_dbl u;-  +   u.d = d;    return (@@ -141,7 +141,7 @@ }  HsInt-isDoubleDenormalized(HsDouble d) +isDoubleDenormalized(HsDouble d) {     union stg_ieee754_dbl u; @@ -154,16 +154,16 @@         - (don't care about setting of sign bit.)      */-    return (  +    return ( 	u.ieee.exponent  == 0 && 	(u.ieee.mantissa0 != 0 || 	 u.ieee.mantissa1 != 0)       );-	 + }  HsInt-isDoubleNegativeZero(HsDouble d) +isDoubleNegativeZero(HsDouble d) {     union stg_ieee754_dbl u; @@ -207,7 +207,7 @@ {     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 (@@ -234,7 +234,7 @@ }  HsInt-isFloatNegativeZero(HsFloat f) +isFloatNegativeZero(HsFloat f) {     union stg_ieee754_flt u;     u.f = f;@@ -246,6 +246,184 @@ 	u.ieee.mantissa == 0); } +/*+ There are glibc versions around with buggy rintf or rint, hence we+ provide our own. We always round ties to even, so we can be simpler.+*/++#define FLT_HIDDEN 0x800000+#define FLT_POWER2 0x1000000++HsFloat+rintFloat(HsFloat f)+{+    union stg_ieee754_flt u;+    u.f = f;+    /* if real exponent > 22, it's already integral, infinite or nan */+    if (u.ieee.exponent > 149)  /* 22 + 127 */+    {+        return u.f;+    }+    if (u.ieee.exponent < 126)  /* (-1) + 127, abs(f) < 0.5 */+    {+        /* only used for rounding to Integral a, so don't care about -0.0 */+        return 0.0;+    }+    /* 0.5 <= abs(f) < 2^23 */+    unsigned int half, mask, mant, frac;+    half = 1 << (149 - u.ieee.exponent);    /* bit for 0.5 */+    mask = 2*half - 1;                      /* fraction bits */+    mant = u.ieee.mantissa | FLT_HIDDEN;    /* add hidden bit */+    frac = mant & mask;                     /* get fraction */+    mant ^= frac;                           /* truncate mantissa */+    if ((frac < half) || ((frac == half) && ((mant & (2*half)) == 0)))+    {+        /* this means we have to truncate */+        if (mant == 0)+        {+            /* f == ±0.5, return 0.0 */+            return 0.0;+        }+        else+        {+            /* remove hidden bit and set mantissa */+            u.ieee.mantissa = mant ^ FLT_HIDDEN;+            return u.f;+        }+    }+    else+    {+        /* round away from zero, increment mantissa */+        mant += 2*half;+        if (mant == FLT_POWER2)+        {+            /* next power of 2, increase exponent an set mantissa to 0 */+            u.ieee.mantissa = 0;+            u.ieee.exponent += 1;+            return u.f;+        }+        else+        {+            /* remove hidden bit and set mantissa */+            u.ieee.mantissa = mant ^ FLT_HIDDEN;+            return u.f;+        }+    }+}++#define DBL_HIDDEN 0x100000+#define DBL_POWER2 0x200000+#define LTOP_BIT 0x80000000++HsDouble+rintDouble(HsDouble d)+{+    union stg_ieee754_dbl u;+    u.d = d;+    /* if real exponent > 51, it's already integral, infinite or nan */+    if (u.ieee.exponent > 1074) /* 51 + 1023 */+    {+        return u.d;+    }+    if (u.ieee.exponent < 1022)  /* (-1) + 1023, abs(d) < 0.5 */+    {+        /* only used for rounding to Integral a, so don't care about -0.0 */+        return 0.0;+    }+    unsigned int half, mask, mant, frac;+    if (u.ieee.exponent < 1043) /* 20 + 1023, real exponent < 20 */+    {+        /* the fractional part meets the higher part of the mantissa */+        half = 1 << (1042 - u.ieee.exponent);   /* bit for 0.5 */+        mask = 2*half - 1;                      /* fraction bits */+        mant = u.ieee.mantissa0 | DBL_HIDDEN;   /* add hidden bit */+        frac = mant & mask;                     /* get fraction */+        mant ^= frac;                           /* truncate mantissa */+        if ((frac < half) ||+            ((frac == half) && (u.ieee.mantissa1 == 0)  /* a tie */+                && ((mant & (2*half)) == 0)))+        {+            /* truncate */+            if (mant == 0)+            {+                /* d = ±0.5, return 0.0 */+                return 0.0;+            }+            /* remove hidden bit and set mantissa */+            u.ieee.mantissa0 = mant ^ DBL_HIDDEN;+            u.ieee.mantissa1 = 0;+            return u.d;+        }+        else    /* round away from zero */+        {+            /* zero low mantissa bits */+            u.ieee.mantissa1 = 0;+            /* increment integer part of mantissa */+            mant += 2*half;+            if (mant == DBL_POWER2)+            {+                /* power of 2, increment exponent and zero mantissa */+                u.ieee.mantissa0 = 0;+                u.ieee.exponent += 1;+                return u.d;+            }+            /* remove hidden bit */+            u.ieee.mantissa0 = mant ^ DBL_HIDDEN;+            return u.d;+        }+    }+    else+    {+        /* 20 <= real exponent < 52, fractional part entirely in mantissa1 */+        half = 1 << (1074 - u.ieee.exponent);   /* bit for 0.5 */+        mask = 2*half - 1;                      /* fraction bits */+        mant = u.ieee.mantissa1;                /* no hidden bit here */+        frac = mant & mask;                     /* get fraction */+        mant ^= frac;                           /* truncate mantissa */+        if ((frac < half) ||+            ((frac == half) &&                  /* tie */+            (((half == LTOP_BIT) ? (u.ieee.mantissa0 & 1)  /* yuck */+                                : (mant & (2*half)))+                                        == 0)))+        {+            /* truncate */+            u.ieee.mantissa1 = mant;+            return u.d;+        }+        else+        {+            /* round away from zero */+            /* increment mantissa */+            mant += 2*half;+            u.ieee.mantissa1 = mant;+            if (mant == 0)+            {+                /* low part of mantissa overflowed */+                /* increment high part of mantissa */+                mant = u.ieee.mantissa0 + 1;+                if (mant == DBL_HIDDEN)+                {+                    /* hit power of 2 */+                    /* zero mantissa */+                    u.ieee.mantissa0 = 0;+                    /* and increment exponent */+                    u.ieee.exponent += 1;+                    return u.d;+                }+                else+                {+                    u.ieee.mantissa0 = mant;+                    return u.d;+                }+            }+            else+            {+                return u.d;+            }+        }+    }+}+ #else /* ! IEEE_FLOATING_POINT */  /* Dummy definitions of predicates - they all return false */@@ -257,5 +435,78 @@ HsInt isFloatInfinite(f) HsFloat f; { return 0; } HsInt isFloatDenormalized(f) HsFloat f; { return 0; } HsInt isFloatNegativeZero(f) HsFloat f; { return 0; }+++/* For exotic floating point formats, we can't do much */+/* We suppose the format has not too many bits */+/* I hope nobody tries to build GHC where this is wrong */++#define FLT_UPP 536870912.0++HsFloat+rintFloat(HsFloat f)+{+    if ((f > FLT_UPP) || (f < (-FLT_UPP)))+    {+        return f;+    }+    else+    {+        int i = (int)f;+        float g = i;+        float d = f - g;+        if (d > 0.5)+        {+            return g + 1.0;+        }+        if (d == 0.5)+        {+            return (i & 1) ? (g + 1.0) : g;+        }+        if (d == -0.5)+        {+            return (i & 1) ? (g - 1.0) : g;+        }+        if (d < -0.5)+        {+            return g - 1.0;+        }+        return g;+    }+}++#define DBL_UPP 2305843009213693952.0++HsDouble+rintDouble(HsDouble d)+{+    if ((d > DBL_UPP) || (d < (-DBL_UPP)))+    {+        return d;+    }+    else+    {+        HsInt64 i = (HsInt64)d;+        double e = i;+        double r = d - e;+        if (r > 0.5)+        {+            return e + 1.0;+        }+        if (r == 0.5)+        {+            return (i & 1) ? (e + 1.0) : e;+        }+        if (r == -0.5)+        {+            return (i & 1) ? (e - 1.0) : e;+        }+        if (r < -0.5)+        {+            return e - 1.0;+        }+        return e;+    }+}  #endif /* ! IEEE_FLOATING_POINT */
configure view
@@ -3113,5737 +3113,17182 @@ ac_compiler_gnu=$ac_cv_c_compiler_gnu  -# do we have long longs?--ac_ext=c-ac_cpp='$CPP $CPPFLAGS'-ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5'-ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5'-ac_compiler_gnu=$ac_cv_c_compiler_gnu-{ $as_echo "$as_me:${as_lineno-$LINENO}: checking how to run the C preprocessor" >&5-$as_echo_n "checking how to run the C preprocessor... " >&6; }-# On Suns, sometimes $CPP names a directory.-if test -n "$CPP" && test -d "$CPP"; then-  CPP=-fi-if test -z "$CPP"; then-  if test "${ac_cv_prog_CPP+set}" = set; then :-  $as_echo_n "(cached) " >&6-else-      # Double quotes because CPP needs to be expanded-    for CPP in "$CC -E" "$CC -E -traditional-cpp" "/lib/cpp"-    do-      ac_preproc_ok=false-for ac_c_preproc_warn_flag in '' yes-do-  # Use a header file that comes with gcc, so configuring glibc-  # with a fresh cross-compiler works.-  # Prefer <limits.h> to <assert.h> if __STDC__ is defined, since-  # <limits.h> exists even on freestanding compilers.-  # On the NeXT, cc -E runs the code through the compiler's parser,-  # not just through cpp. "Syntax error" is here to catch this case.-  cat confdefs.h - <<_ACEOF >conftest.$ac_ext-/* end confdefs.h.  */-#ifdef __STDC__-# include <limits.h>-#else-# include <assert.h>-#endif-		     Syntax error-_ACEOF-if ac_fn_c_try_cpp "$LINENO"; then :--else-  # Broken: fails on valid input.-continue-fi-rm -f conftest.err conftest.i conftest.$ac_ext--  # OK, works on sane cases.  Now check whether nonexistent headers-  # can be detected and how.-  cat confdefs.h - <<_ACEOF >conftest.$ac_ext-/* end confdefs.h.  */-#include <ac_nonexistent.h>-_ACEOF-if ac_fn_c_try_cpp "$LINENO"; then :-  # Broken: success on invalid input.-continue-else-  # Passes both tests.-ac_preproc_ok=:-break-fi-rm -f conftest.err conftest.i conftest.$ac_ext--done-# Because of `break', _AC_PREPROC_IFELSE's cleaning code was skipped.-rm -f conftest.i conftest.err conftest.$ac_ext-if $ac_preproc_ok; then :-  break-fi--    done-    ac_cv_prog_CPP=$CPP--fi-  CPP=$ac_cv_prog_CPP-else-  ac_cv_prog_CPP=$CPP-fi-{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $CPP" >&5-$as_echo "$CPP" >&6; }-ac_preproc_ok=false-for ac_c_preproc_warn_flag in '' yes-do-  # Use a header file that comes with gcc, so configuring glibc-  # with a fresh cross-compiler works.-  # Prefer <limits.h> to <assert.h> if __STDC__ is defined, since-  # <limits.h> exists even on freestanding compilers.-  # On the NeXT, cc -E runs the code through the compiler's parser,-  # not just through cpp. "Syntax error" is here to catch this case.-  cat confdefs.h - <<_ACEOF >conftest.$ac_ext-/* end confdefs.h.  */-#ifdef __STDC__-# include <limits.h>-#else-# include <assert.h>-#endif-		     Syntax error-_ACEOF-if ac_fn_c_try_cpp "$LINENO"; then :--else-  # Broken: fails on valid input.-continue-fi-rm -f conftest.err conftest.i conftest.$ac_ext--  # OK, works on sane cases.  Now check whether nonexistent headers-  # can be detected and how.-  cat confdefs.h - <<_ACEOF >conftest.$ac_ext-/* end confdefs.h.  */-#include <ac_nonexistent.h>-_ACEOF-if ac_fn_c_try_cpp "$LINENO"; then :-  # Broken: success on invalid input.-continue-else-  # Passes both tests.-ac_preproc_ok=:-break-fi-rm -f conftest.err conftest.i conftest.$ac_ext--done-# Because of `break', _AC_PREPROC_IFELSE's cleaning code was skipped.-rm -f conftest.i conftest.err conftest.$ac_ext-if $ac_preproc_ok; then :--else-  { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5-$as_echo "$as_me: error: in \`$ac_pwd':" >&2;}-as_fn_error $? "C preprocessor \"$CPP\" fails sanity check-See \`config.log' for more details" "$LINENO" 5 ; }-fi--ac_ext=c-ac_cpp='$CPP $CPPFLAGS'-ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5'-ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5'-ac_compiler_gnu=$ac_cv_c_compiler_gnu---{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for grep that handles long lines and -e" >&5-$as_echo_n "checking for grep that handles long lines and -e... " >&6; }-if test "${ac_cv_path_GREP+set}" = set; then :-  $as_echo_n "(cached) " >&6-else-  if test -z "$GREP"; then-  ac_path_GREP_found=false-  # Loop through the user's path and test for each of PROGNAME-LIST-  as_save_IFS=$IFS; IFS=$PATH_SEPARATOR-for as_dir in $PATH$PATH_SEPARATOR/usr/xpg4/bin-do-  IFS=$as_save_IFS-  test -z "$as_dir" && as_dir=.-    for ac_prog in grep ggrep; do-    for ac_exec_ext in '' $ac_executable_extensions; do-      ac_path_GREP="$as_dir/$ac_prog$ac_exec_ext"-      { test -f "$ac_path_GREP" && $as_test_x "$ac_path_GREP"; } || continue-# Check for GNU ac_path_GREP and select it if it is found.-  # Check for GNU $ac_path_GREP-case `"$ac_path_GREP" --version 2>&1` in-*GNU*)-  ac_cv_path_GREP="$ac_path_GREP" ac_path_GREP_found=:;;-*)-  ac_count=0-  $as_echo_n 0123456789 >"conftest.in"-  while :-  do-    cat "conftest.in" "conftest.in" >"conftest.tmp"-    mv "conftest.tmp" "conftest.in"-    cp "conftest.in" "conftest.nl"-    $as_echo 'GREP' >> "conftest.nl"-    "$ac_path_GREP" -e 'GREP$' -e '-(cannot match)-' < "conftest.nl" >"conftest.out" 2>/dev/null || break-    diff "conftest.out" "conftest.nl" >/dev/null 2>&1 || break-    as_fn_arith $ac_count + 1 && ac_count=$as_val-    if test $ac_count -gt ${ac_path_GREP_max-0}; then-      # Best one so far, save it but keep looking for a better one-      ac_cv_path_GREP="$ac_path_GREP"-      ac_path_GREP_max=$ac_count-    fi-    # 10*(2^10) chars as input seems more than enough-    test $ac_count -gt 10 && break-  done-  rm -f conftest.in conftest.tmp conftest.nl conftest.out;;-esac--      $ac_path_GREP_found && break 3-    done-  done-  done-IFS=$as_save_IFS-  if test -z "$ac_cv_path_GREP"; then-    as_fn_error $? "no acceptable grep could be found in $PATH$PATH_SEPARATOR/usr/xpg4/bin" "$LINENO" 5-  fi-else-  ac_cv_path_GREP=$GREP-fi--fi-{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_path_GREP" >&5-$as_echo "$ac_cv_path_GREP" >&6; }- GREP="$ac_cv_path_GREP"---{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for egrep" >&5-$as_echo_n "checking for egrep... " >&6; }-if test "${ac_cv_path_EGREP+set}" = set; then :-  $as_echo_n "(cached) " >&6-else-  if echo a | $GREP -E '(a|b)' >/dev/null 2>&1-   then ac_cv_path_EGREP="$GREP -E"-   else-     if test -z "$EGREP"; then-  ac_path_EGREP_found=false-  # Loop through the user's path and test for each of PROGNAME-LIST-  as_save_IFS=$IFS; IFS=$PATH_SEPARATOR-for as_dir in $PATH$PATH_SEPARATOR/usr/xpg4/bin-do-  IFS=$as_save_IFS-  test -z "$as_dir" && as_dir=.-    for ac_prog in egrep; do-    for ac_exec_ext in '' $ac_executable_extensions; do-      ac_path_EGREP="$as_dir/$ac_prog$ac_exec_ext"-      { test -f "$ac_path_EGREP" && $as_test_x "$ac_path_EGREP"; } || continue-# Check for GNU ac_path_EGREP and select it if it is found.-  # Check for GNU $ac_path_EGREP-case `"$ac_path_EGREP" --version 2>&1` in-*GNU*)-  ac_cv_path_EGREP="$ac_path_EGREP" ac_path_EGREP_found=:;;-*)-  ac_count=0-  $as_echo_n 0123456789 >"conftest.in"-  while :-  do-    cat "conftest.in" "conftest.in" >"conftest.tmp"-    mv "conftest.tmp" "conftest.in"-    cp "conftest.in" "conftest.nl"-    $as_echo 'EGREP' >> "conftest.nl"-    "$ac_path_EGREP" 'EGREP$' < "conftest.nl" >"conftest.out" 2>/dev/null || break-    diff "conftest.out" "conftest.nl" >/dev/null 2>&1 || break-    as_fn_arith $ac_count + 1 && ac_count=$as_val-    if test $ac_count -gt ${ac_path_EGREP_max-0}; then-      # Best one so far, save it but keep looking for a better one-      ac_cv_path_EGREP="$ac_path_EGREP"-      ac_path_EGREP_max=$ac_count-    fi-    # 10*(2^10) chars as input seems more than enough-    test $ac_count -gt 10 && break-  done-  rm -f conftest.in conftest.tmp conftest.nl conftest.out;;-esac--      $ac_path_EGREP_found && break 3-    done-  done-  done-IFS=$as_save_IFS-  if test -z "$ac_cv_path_EGREP"; then-    as_fn_error $? "no acceptable egrep could be found in $PATH$PATH_SEPARATOR/usr/xpg4/bin" "$LINENO" 5-  fi-else-  ac_cv_path_EGREP=$EGREP-fi--   fi-fi-{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_path_EGREP" >&5-$as_echo "$ac_cv_path_EGREP" >&6; }- EGREP="$ac_cv_path_EGREP"---{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for ANSI C header files" >&5-$as_echo_n "checking for ANSI C header files... " >&6; }-if test "${ac_cv_header_stdc+set}" = set; then :-  $as_echo_n "(cached) " >&6-else-  cat confdefs.h - <<_ACEOF >conftest.$ac_ext-/* end confdefs.h.  */-#include <stdlib.h>-#include <stdarg.h>-#include <string.h>-#include <float.h>--int-main ()-{--  ;-  return 0;-}-_ACEOF-if ac_fn_c_try_compile "$LINENO"; then :-  ac_cv_header_stdc=yes-else-  ac_cv_header_stdc=no-fi-rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext--if test $ac_cv_header_stdc = yes; then-  # SunOS 4.x string.h does not declare mem*, contrary to ANSI.-  cat confdefs.h - <<_ACEOF >conftest.$ac_ext-/* end confdefs.h.  */-#include <string.h>--_ACEOF-if (eval "$ac_cpp conftest.$ac_ext") 2>&5 |-  $EGREP "memchr" >/dev/null 2>&1; then :--else-  ac_cv_header_stdc=no-fi-rm -f conftest*--fi--if test $ac_cv_header_stdc = yes; then-  # ISC 2.0.2 stdlib.h does not declare free, contrary to ANSI.-  cat confdefs.h - <<_ACEOF >conftest.$ac_ext-/* end confdefs.h.  */-#include <stdlib.h>--_ACEOF-if (eval "$ac_cpp conftest.$ac_ext") 2>&5 |-  $EGREP "free" >/dev/null 2>&1; then :--else-  ac_cv_header_stdc=no-fi-rm -f conftest*--fi--if test $ac_cv_header_stdc = yes; then-  # /bin/cc in Irix-4.0.5 gets non-ANSI ctype macros unless using -ansi.-  if test "$cross_compiling" = yes; then :-  :-else-  cat confdefs.h - <<_ACEOF >conftest.$ac_ext-/* end confdefs.h.  */-#include <ctype.h>-#include <stdlib.h>-#if ((' ' & 0x0FF) == 0x020)-# define ISLOWER(c) ('a' <= (c) && (c) <= 'z')-# define TOUPPER(c) (ISLOWER(c) ? 'A' + ((c) - 'a') : (c))-#else-# define ISLOWER(c) \-		   (('a' <= (c) && (c) <= 'i') \-		     || ('j' <= (c) && (c) <= 'r') \-		     || ('s' <= (c) && (c) <= 'z'))-# define TOUPPER(c) (ISLOWER(c) ? ((c) | 0x40) : (c))-#endif--#define XOR(e, f) (((e) && !(f)) || (!(e) && (f)))-int-main ()-{-  int i;-  for (i = 0; i < 256; i++)-    if (XOR (islower (i), ISLOWER (i))-	|| toupper (i) != TOUPPER (i))-      return 2;-  return 0;-}-_ACEOF-if ac_fn_c_try_run "$LINENO"; then :--else-  ac_cv_header_stdc=no-fi-rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \-  conftest.$ac_objext conftest.beam conftest.$ac_ext-fi--fi-fi-{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_header_stdc" >&5-$as_echo "$ac_cv_header_stdc" >&6; }-if test $ac_cv_header_stdc = yes; then--$as_echo "#define STDC_HEADERS 1" >>confdefs.h--fi--# On IRIX 5.3, sys/types and inttypes.h are conflicting.-for ac_header in sys/types.h sys/stat.h stdlib.h string.h memory.h strings.h \-		  inttypes.h stdint.h unistd.h-do :-  as_ac_Header=`$as_echo "ac_cv_header_$ac_header" | $as_tr_sh`-ac_fn_c_check_header_compile "$LINENO" "$ac_header" "$as_ac_Header" "$ac_includes_default-"-if eval test \"x\$"$as_ac_Header"\" = x"yes"; then :-  cat >>confdefs.h <<_ACEOF-#define `$as_echo "HAVE_$ac_header" | $as_tr_cpp` 1-_ACEOF--fi--done---ac_fn_c_check_type "$LINENO" "long long" "ac_cv_type_long_long" "$ac_includes_default"-if test "x$ac_cv_type_long_long" = x""yes; then :--cat >>confdefs.h <<_ACEOF-#define HAVE_LONG_LONG 1-_ACEOF---fi---{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for ANSI C header files" >&5-$as_echo_n "checking for ANSI C header files... " >&6; }-if test "${ac_cv_header_stdc+set}" = set; then :-  $as_echo_n "(cached) " >&6-else-  cat confdefs.h - <<_ACEOF >conftest.$ac_ext-/* end confdefs.h.  */-#include <stdlib.h>-#include <stdarg.h>-#include <string.h>-#include <float.h>--int-main ()-{--  ;-  return 0;-}-_ACEOF-if ac_fn_c_try_compile "$LINENO"; then :-  ac_cv_header_stdc=yes-else-  ac_cv_header_stdc=no-fi-rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext--if test $ac_cv_header_stdc = yes; then-  # SunOS 4.x string.h does not declare mem*, contrary to ANSI.-  cat confdefs.h - <<_ACEOF >conftest.$ac_ext-/* end confdefs.h.  */-#include <string.h>--_ACEOF-if (eval "$ac_cpp conftest.$ac_ext") 2>&5 |-  $EGREP "memchr" >/dev/null 2>&1; then :--else-  ac_cv_header_stdc=no-fi-rm -f conftest*--fi--if test $ac_cv_header_stdc = yes; then-  # ISC 2.0.2 stdlib.h does not declare free, contrary to ANSI.-  cat confdefs.h - <<_ACEOF >conftest.$ac_ext-/* end confdefs.h.  */-#include <stdlib.h>--_ACEOF-if (eval "$ac_cpp conftest.$ac_ext") 2>&5 |-  $EGREP "free" >/dev/null 2>&1; then :--else-  ac_cv_header_stdc=no-fi-rm -f conftest*--fi--if test $ac_cv_header_stdc = yes; then-  # /bin/cc in Irix-4.0.5 gets non-ANSI ctype macros unless using -ansi.-  if test "$cross_compiling" = yes; then :-  :-else-  cat confdefs.h - <<_ACEOF >conftest.$ac_ext-/* end confdefs.h.  */-#include <ctype.h>-#include <stdlib.h>-#if ((' ' & 0x0FF) == 0x020)-# define ISLOWER(c) ('a' <= (c) && (c) <= 'z')-# define TOUPPER(c) (ISLOWER(c) ? 'A' + ((c) - 'a') : (c))-#else-# define ISLOWER(c) \-		   (('a' <= (c) && (c) <= 'i') \-		     || ('j' <= (c) && (c) <= 'r') \-		     || ('s' <= (c) && (c) <= 'z'))-# define TOUPPER(c) (ISLOWER(c) ? ((c) | 0x40) : (c))-#endif--#define XOR(e, f) (((e) && !(f)) || (!(e) && (f)))-int-main ()-{-  int i;-  for (i = 0; i < 256; i++)-    if (XOR (islower (i), ISLOWER (i))-	|| toupper (i) != TOUPPER (i))-      return 2;-  return 0;-}-_ACEOF-if ac_fn_c_try_run "$LINENO"; then :--else-  ac_cv_header_stdc=no-fi-rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \-  conftest.$ac_objext conftest.beam conftest.$ac_ext-fi--fi-fi-{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_header_stdc" >&5-$as_echo "$ac_cv_header_stdc" >&6; }-if test $ac_cv_header_stdc = yes; then--$as_echo "#define STDC_HEADERS 1" >>confdefs.h--fi---# check for specific header (.h) files that we are interested in-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 poll.h sys/epoll.h sys/event.h sys/eventfd.h-do :-  as_ac_Header=`$as_echo "ac_cv_header_$ac_header" | $as_tr_sh`-ac_fn_c_check_header_mongrel "$LINENO" "$ac_header" "$as_ac_Header" "$ac_includes_default"-if eval test \"x\$"$as_ac_Header"\" = x"yes"; then :-  cat >>confdefs.h <<_ACEOF-#define `$as_echo "HAVE_$ac_header" | $as_tr_cpp` 1-_ACEOF--fi--done---# 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.-# Check whether --enable-largefile was given.-if test "${enable_largefile+set}" = set; then :-  enableval=$enable_largefile;-fi--if test "$enable_largefile" != no; then--  { $as_echo "$as_me:${as_lineno-$LINENO}: checking for special C compiler options needed for large files" >&5-$as_echo_n "checking for special C compiler options needed for large files... " >&6; }-if test "${ac_cv_sys_largefile_CC+set}" = set; then :-  $as_echo_n "(cached) " >&6-else-  ac_cv_sys_largefile_CC=no-     if test "$GCC" != yes; then-       ac_save_CC=$CC-       while :; do-	 # IRIX 6.2 and later do not support large files by default,-	 # so use the C compiler's -n32 option if that helps.-	 cat confdefs.h - <<_ACEOF >conftest.$ac_ext-/* end confdefs.h.  */-#include <sys/types.h>- /* Check that off_t can represent 2**63 - 1 correctly.-    We can't simply define LARGE_OFF_T to be 9223372036854775807,-    since some C++ compilers masquerading as C compilers-    incorrectly reject 9223372036854775807.  */-#define LARGE_OFF_T (((off_t) 1 << 62) - 1 + ((off_t) 1 << 62))-  int off_t_is_large[(LARGE_OFF_T % 2147483629 == 721-		       && LARGE_OFF_T % 2147483647 == 1)-		      ? 1 : -1];-int-main ()-{--  ;-  return 0;-}-_ACEOF-	 if ac_fn_c_try_compile "$LINENO"; then :-  break-fi-rm -f core conftest.err conftest.$ac_objext-	 CC="$CC -n32"-	 if ac_fn_c_try_compile "$LINENO"; then :-  ac_cv_sys_largefile_CC=' -n32'; break-fi-rm -f core conftest.err conftest.$ac_objext-	 break-       done-       CC=$ac_save_CC-       rm -f conftest.$ac_ext-    fi-fi-{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_sys_largefile_CC" >&5-$as_echo "$ac_cv_sys_largefile_CC" >&6; }-  if test "$ac_cv_sys_largefile_CC" != no; then-    CC=$CC$ac_cv_sys_largefile_CC-  fi--  { $as_echo "$as_me:${as_lineno-$LINENO}: checking for _FILE_OFFSET_BITS value needed for large files" >&5-$as_echo_n "checking for _FILE_OFFSET_BITS value needed for large files... " >&6; }-if test "${ac_cv_sys_file_offset_bits+set}" = set; then :-  $as_echo_n "(cached) " >&6-else-  while :; do-  cat confdefs.h - <<_ACEOF >conftest.$ac_ext-/* end confdefs.h.  */-#include <sys/types.h>- /* Check that off_t can represent 2**63 - 1 correctly.-    We can't simply define LARGE_OFF_T to be 9223372036854775807,-    since some C++ compilers masquerading as C compilers-    incorrectly reject 9223372036854775807.  */-#define LARGE_OFF_T (((off_t) 1 << 62) - 1 + ((off_t) 1 << 62))-  int off_t_is_large[(LARGE_OFF_T % 2147483629 == 721-		       && LARGE_OFF_T % 2147483647 == 1)-		      ? 1 : -1];-int-main ()-{--  ;-  return 0;-}-_ACEOF-if ac_fn_c_try_compile "$LINENO"; then :-  ac_cv_sys_file_offset_bits=no; break-fi-rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext-  cat confdefs.h - <<_ACEOF >conftest.$ac_ext-/* end confdefs.h.  */-#define _FILE_OFFSET_BITS 64-#include <sys/types.h>- /* Check that off_t can represent 2**63 - 1 correctly.-    We can't simply define LARGE_OFF_T to be 9223372036854775807,-    since some C++ compilers masquerading as C compilers-    incorrectly reject 9223372036854775807.  */-#define LARGE_OFF_T (((off_t) 1 << 62) - 1 + ((off_t) 1 << 62))-  int off_t_is_large[(LARGE_OFF_T % 2147483629 == 721-		       && LARGE_OFF_T % 2147483647 == 1)-		      ? 1 : -1];-int-main ()-{--  ;-  return 0;-}-_ACEOF-if ac_fn_c_try_compile "$LINENO"; then :-  ac_cv_sys_file_offset_bits=64; break-fi-rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext-  ac_cv_sys_file_offset_bits=unknown-  break-done-fi-{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_sys_file_offset_bits" >&5-$as_echo "$ac_cv_sys_file_offset_bits" >&6; }-case $ac_cv_sys_file_offset_bits in #(-  no | unknown) ;;-  *)-cat >>confdefs.h <<_ACEOF-#define _FILE_OFFSET_BITS $ac_cv_sys_file_offset_bits-_ACEOF-;;-esac-rm -rf conftest*-  if test $ac_cv_sys_file_offset_bits = unknown; then-    { $as_echo "$as_me:${as_lineno-$LINENO}: checking for _LARGE_FILES value needed for large files" >&5-$as_echo_n "checking for _LARGE_FILES value needed for large files... " >&6; }-if test "${ac_cv_sys_large_files+set}" = set; then :-  $as_echo_n "(cached) " >&6-else-  while :; do-  cat confdefs.h - <<_ACEOF >conftest.$ac_ext-/* end confdefs.h.  */-#include <sys/types.h>- /* Check that off_t can represent 2**63 - 1 correctly.-    We can't simply define LARGE_OFF_T to be 9223372036854775807,-    since some C++ compilers masquerading as C compilers-    incorrectly reject 9223372036854775807.  */-#define LARGE_OFF_T (((off_t) 1 << 62) - 1 + ((off_t) 1 << 62))-  int off_t_is_large[(LARGE_OFF_T % 2147483629 == 721-		       && LARGE_OFF_T % 2147483647 == 1)-		      ? 1 : -1];-int-main ()-{--  ;-  return 0;-}-_ACEOF-if ac_fn_c_try_compile "$LINENO"; then :-  ac_cv_sys_large_files=no; break-fi-rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext-  cat confdefs.h - <<_ACEOF >conftest.$ac_ext-/* end confdefs.h.  */-#define _LARGE_FILES 1-#include <sys/types.h>- /* Check that off_t can represent 2**63 - 1 correctly.-    We can't simply define LARGE_OFF_T to be 9223372036854775807,-    since some C++ compilers masquerading as C compilers-    incorrectly reject 9223372036854775807.  */-#define LARGE_OFF_T (((off_t) 1 << 62) - 1 + ((off_t) 1 << 62))-  int off_t_is_large[(LARGE_OFF_T % 2147483629 == 721-		       && LARGE_OFF_T % 2147483647 == 1)-		      ? 1 : -1];-int-main ()-{--  ;-  return 0;-}-_ACEOF-if ac_fn_c_try_compile "$LINENO"; then :-  ac_cv_sys_large_files=1; break-fi-rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext-  ac_cv_sys_large_files=unknown-  break-done-fi-{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_sys_large_files" >&5-$as_echo "$ac_cv_sys_large_files" >&6; }-case $ac_cv_sys_large_files in #(-  no | unknown) ;;-  *)-cat >>confdefs.h <<_ACEOF-#define _LARGE_FILES $ac_cv_sys_large_files-_ACEOF-;;-esac-rm -rf conftest*-  fi-fi---for ac_header in wctype.h-do :-  ac_fn_c_check_header_mongrel "$LINENO" "wctype.h" "ac_cv_header_wctype_h" "$ac_includes_default"-if test "x$ac_cv_header_wctype_h" = x""yes; then :-  cat >>confdefs.h <<_ACEOF-#define HAVE_WCTYPE_H 1-_ACEOF- for ac_func in iswspace-do :-  ac_fn_c_check_func "$LINENO" "iswspace" "ac_cv_func_iswspace"-if test "x$ac_cv_func_iswspace" = x""yes; then :-  cat >>confdefs.h <<_ACEOF-#define HAVE_ISWSPACE 1-_ACEOF--fi-done--fi--done---for ac_func in lstat-do :-  ac_fn_c_check_func "$LINENO" "lstat" "ac_cv_func_lstat"-if test "x$ac_cv_func_lstat" = x""yes; then :-  cat >>confdefs.h <<_ACEOF-#define HAVE_LSTAT 1-_ACEOF--fi-done--for ac_func in getclock getrusage times-do :-  as_ac_var=`$as_echo "ac_cv_func_$ac_func" | $as_tr_sh`-ac_fn_c_check_func "$LINENO" "$ac_func" "$as_ac_var"-if eval test \"x\$"$as_ac_var"\" = x"yes"; then :-  cat >>confdefs.h <<_ACEOF-#define `$as_echo "HAVE_$ac_func" | $as_tr_cpp` 1-_ACEOF--fi-done--for ac_func in _chsize ftruncate-do :-  as_ac_var=`$as_echo "ac_cv_func_$ac_func" | $as_tr_sh`-ac_fn_c_check_func "$LINENO" "$ac_func" "$as_ac_var"-if eval test \"x\$"$as_ac_var"\" = x"yes"; then :-  cat >>confdefs.h <<_ACEOF-#define `$as_echo "HAVE_$ac_func" | $as_tr_cpp` 1-_ACEOF--fi-done---for ac_func in epoll_create1 epoll_ctl eventfd kevent kevent64 kqueue poll-do :-  as_ac_var=`$as_echo "ac_cv_func_$ac_func" | $as_tr_sh`-ac_fn_c_check_func "$LINENO" "$ac_func" "$as_ac_var"-if eval test \"x\$"$as_ac_var"\" = x"yes"; then :-  cat >>confdefs.h <<_ACEOF-#define `$as_echo "HAVE_$ac_func" | $as_tr_cpp` 1-_ACEOF--fi-done---# event-related fun--if test "$ac_cv_header_sys_epoll_h" = yes -a "$ac_cv_func_epoll_ctl" = yes; then--$as_echo "#define HAVE_EPOLL 1" >>confdefs.h--fi--if test "$ac_cv_header_sys_event_h" = yes -a "$ac_cv_func_kqueue" = yes; then--$as_echo "#define HAVE_KQUEUE 1" >>confdefs.h--fi--if test "$ac_cv_header_poll_h" = yes -a "$ac_cv_func_poll" = yes; then--$as_echo "#define HAVE_POLL 1" >>confdefs.h--fi----# 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-{ $as_echo "$as_me:${as_lineno-$LINENO}: checking Haskell type for char" >&5-$as_echo_n "checking Haskell type for char... " >&6; }-if test "${fptools_cv_htype_char+set}" = set; then :-  $as_echo_n "(cached) " >&6-else-  fptools_cv_htype_sup_char=yes-fp_check_htype_save_cppflags="$CPPFLAGS"-CPPFLAGS="$CPPFLAGS $X_CFLAGS"-if test "$cross_compiling" = yes; then :-  fptools_cv_htype_char=NotReallyATypeCross; fptools_cv_htype_sup_char=no-else-  cat confdefs.h - <<_ACEOF >conftest.$ac_ext-/* end confdefs.h.  */-#include <stdio.h>-#include <stddef.h>--#if HAVE_SYS_TYPES_H-# include <sys/types.h>-#endif--#if HAVE_UNISTD_H-# include <unistd.h>-#endif--#if HAVE_SYS_STAT_H-# include <sys/stat.h>-#endif--#if HAVE_FCNTL_H-# include <fcntl.h>-#endif--#if HAVE_SIGNAL_H-# include <signal.h>-#endif--#if HAVE_TIME_H-# include <time.h>-#endif--#if HAVE_TERMIOS_H-# include <termios.h>-#endif--#if HAVE_STRING_H-# include <string.h>-#endif--#if HAVE_CTYPE_H-# include <ctype.h>-#endif--#if HAVE_INTTYPES_H-# include <inttypes.h>-#else-# if HAVE_STDINT_H-#  include <stdint.h>-# endif-#endif--#if defined(HAVE_GL_GL_H)-# include <GL/gl.h>-#elif defined(HAVE_OPENGL_GL_H)-# include <OpenGL/gl.h>-#endif--#if defined(HAVE_AL_AL_H)-# include <AL/al.h>-#elif defined(HAVE_OPENAL_AL_H)-# include <OpenAL/al.h>-#endif--#if defined(HAVE_AL_ALC_H)-# include <AL/alc.h>-#elif defined(HAVE_OPENAL_ALC_H)-# include <OpenAL/alc.h>-#endif--#if HAVE_SYS_RESOURCE_H-# include <sys/resource.h>-#endif--#include <stdlib.h>--typedef char testing;--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",-           (int)(sizeof(testing)*8));-  } else {-    fprintf(f,"%s\n",-           (sizeof(testing) >  sizeof(double)) ? "LDouble" :-           (sizeof(testing) == sizeof(double)) ? "Double"  : "Float");-  }-  fclose(f);-  exit(0);-}-_ACEOF-if ac_fn_c_try_run "$LINENO"; then :-  fptools_cv_htype_char=`cat conftestval`-else-  fptools_cv_htype_char=NotReallyAType; fptools_cv_htype_sup_char=no-fi-rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \-  conftest.$ac_objext conftest.beam conftest.$ac_ext-fi--CPPFLAGS="$fp_check_htype_save_cppflags"-fi- if test "$fptools_cv_htype_sup_char" = yes; then-  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $fptools_cv_htype_char" >&5-$as_echo "$fptools_cv_htype_char" >&6; }--cat >>confdefs.h <<_ACEOF-#define HTYPE_CHAR $fptools_cv_htype_char-_ACEOF--else-  { $as_echo "$as_me:${as_lineno-$LINENO}: result: not supported" >&5-$as_echo "not supported" >&6; }-fi--{ $as_echo "$as_me:${as_lineno-$LINENO}: checking Haskell type for signed char" >&5-$as_echo_n "checking Haskell type for signed char... " >&6; }-if test "${fptools_cv_htype_signed_char+set}" = set; then :-  $as_echo_n "(cached) " >&6-else-  fptools_cv_htype_sup_signed_char=yes-fp_check_htype_save_cppflags="$CPPFLAGS"-CPPFLAGS="$CPPFLAGS $X_CFLAGS"-if test "$cross_compiling" = yes; then :-  fptools_cv_htype_signed_char=NotReallyATypeCross; fptools_cv_htype_sup_signed_char=no-else-  cat confdefs.h - <<_ACEOF >conftest.$ac_ext-/* end confdefs.h.  */-#include <stdio.h>-#include <stddef.h>--#if HAVE_SYS_TYPES_H-# include <sys/types.h>-#endif--#if HAVE_UNISTD_H-# include <unistd.h>-#endif--#if HAVE_SYS_STAT_H-# include <sys/stat.h>-#endif--#if HAVE_FCNTL_H-# include <fcntl.h>-#endif--#if HAVE_SIGNAL_H-# include <signal.h>-#endif--#if HAVE_TIME_H-# include <time.h>-#endif--#if HAVE_TERMIOS_H-# include <termios.h>-#endif--#if HAVE_STRING_H-# include <string.h>-#endif--#if HAVE_CTYPE_H-# include <ctype.h>-#endif--#if HAVE_INTTYPES_H-# include <inttypes.h>-#else-# if HAVE_STDINT_H-#  include <stdint.h>-# endif-#endif--#if defined(HAVE_GL_GL_H)-# include <GL/gl.h>-#elif defined(HAVE_OPENGL_GL_H)-# include <OpenGL/gl.h>-#endif--#if defined(HAVE_AL_AL_H)-# include <AL/al.h>-#elif defined(HAVE_OPENAL_AL_H)-# include <OpenAL/al.h>-#endif--#if defined(HAVE_AL_ALC_H)-# include <AL/alc.h>-#elif defined(HAVE_OPENAL_ALC_H)-# include <OpenAL/alc.h>-#endif--#if HAVE_SYS_RESOURCE_H-# include <sys/resource.h>-#endif--#include <stdlib.h>--typedef signed char testing;--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",-           (int)(sizeof(testing)*8));-  } else {-    fprintf(f,"%s\n",-           (sizeof(testing) >  sizeof(double)) ? "LDouble" :-           (sizeof(testing) == sizeof(double)) ? "Double"  : "Float");-  }-  fclose(f);-  exit(0);-}-_ACEOF-if ac_fn_c_try_run "$LINENO"; then :-  fptools_cv_htype_signed_char=`cat conftestval`-else-  fptools_cv_htype_signed_char=NotReallyAType; fptools_cv_htype_sup_signed_char=no-fi-rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \-  conftest.$ac_objext conftest.beam conftest.$ac_ext-fi--CPPFLAGS="$fp_check_htype_save_cppflags"-fi- if test "$fptools_cv_htype_sup_signed_char" = yes; then-  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $fptools_cv_htype_signed_char" >&5-$as_echo "$fptools_cv_htype_signed_char" >&6; }--cat >>confdefs.h <<_ACEOF-#define HTYPE_SIGNED_CHAR $fptools_cv_htype_signed_char-_ACEOF--else-  { $as_echo "$as_me:${as_lineno-$LINENO}: result: not supported" >&5-$as_echo "not supported" >&6; }-fi--{ $as_echo "$as_me:${as_lineno-$LINENO}: checking Haskell type for unsigned char" >&5-$as_echo_n "checking Haskell type for unsigned char... " >&6; }-if test "${fptools_cv_htype_unsigned_char+set}" = set; then :-  $as_echo_n "(cached) " >&6-else-  fptools_cv_htype_sup_unsigned_char=yes-fp_check_htype_save_cppflags="$CPPFLAGS"-CPPFLAGS="$CPPFLAGS $X_CFLAGS"-if test "$cross_compiling" = yes; then :-  fptools_cv_htype_unsigned_char=NotReallyATypeCross; fptools_cv_htype_sup_unsigned_char=no-else-  cat confdefs.h - <<_ACEOF >conftest.$ac_ext-/* end confdefs.h.  */-#include <stdio.h>-#include <stddef.h>--#if HAVE_SYS_TYPES_H-# include <sys/types.h>-#endif--#if HAVE_UNISTD_H-# include <unistd.h>-#endif--#if HAVE_SYS_STAT_H-# include <sys/stat.h>-#endif--#if HAVE_FCNTL_H-# include <fcntl.h>-#endif--#if HAVE_SIGNAL_H-# include <signal.h>-#endif--#if HAVE_TIME_H-# include <time.h>-#endif--#if HAVE_TERMIOS_H-# include <termios.h>-#endif--#if HAVE_STRING_H-# include <string.h>-#endif--#if HAVE_CTYPE_H-# include <ctype.h>-#endif--#if HAVE_INTTYPES_H-# include <inttypes.h>-#else-# if HAVE_STDINT_H-#  include <stdint.h>-# endif-#endif--#if defined(HAVE_GL_GL_H)-# include <GL/gl.h>-#elif defined(HAVE_OPENGL_GL_H)-# include <OpenGL/gl.h>-#endif--#if defined(HAVE_AL_AL_H)-# include <AL/al.h>-#elif defined(HAVE_OPENAL_AL_H)-# include <OpenAL/al.h>-#endif--#if defined(HAVE_AL_ALC_H)-# include <AL/alc.h>-#elif defined(HAVE_OPENAL_ALC_H)-# include <OpenAL/alc.h>-#endif--#if HAVE_SYS_RESOURCE_H-# include <sys/resource.h>-#endif--#include <stdlib.h>--typedef unsigned char testing;--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",-           (int)(sizeof(testing)*8));-  } else {-    fprintf(f,"%s\n",-           (sizeof(testing) >  sizeof(double)) ? "LDouble" :-           (sizeof(testing) == sizeof(double)) ? "Double"  : "Float");-  }-  fclose(f);-  exit(0);-}-_ACEOF-if ac_fn_c_try_run "$LINENO"; then :-  fptools_cv_htype_unsigned_char=`cat conftestval`-else-  fptools_cv_htype_unsigned_char=NotReallyAType; fptools_cv_htype_sup_unsigned_char=no-fi-rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \-  conftest.$ac_objext conftest.beam conftest.$ac_ext-fi--CPPFLAGS="$fp_check_htype_save_cppflags"-fi- if test "$fptools_cv_htype_sup_unsigned_char" = yes; then-  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $fptools_cv_htype_unsigned_char" >&5-$as_echo "$fptools_cv_htype_unsigned_char" >&6; }--cat >>confdefs.h <<_ACEOF-#define HTYPE_UNSIGNED_CHAR $fptools_cv_htype_unsigned_char-_ACEOF--else-  { $as_echo "$as_me:${as_lineno-$LINENO}: result: not supported" >&5-$as_echo "not supported" >&6; }-fi--{ $as_echo "$as_me:${as_lineno-$LINENO}: checking Haskell type for short" >&5-$as_echo_n "checking Haskell type for short... " >&6; }-if test "${fptools_cv_htype_short+set}" = set; then :-  $as_echo_n "(cached) " >&6-else-  fptools_cv_htype_sup_short=yes-fp_check_htype_save_cppflags="$CPPFLAGS"-CPPFLAGS="$CPPFLAGS $X_CFLAGS"-if test "$cross_compiling" = yes; then :-  fptools_cv_htype_short=NotReallyATypeCross; fptools_cv_htype_sup_short=no-else-  cat confdefs.h - <<_ACEOF >conftest.$ac_ext-/* end confdefs.h.  */-#include <stdio.h>-#include <stddef.h>--#if HAVE_SYS_TYPES_H-# include <sys/types.h>-#endif--#if HAVE_UNISTD_H-# include <unistd.h>-#endif--#if HAVE_SYS_STAT_H-# include <sys/stat.h>-#endif--#if HAVE_FCNTL_H-# include <fcntl.h>-#endif--#if HAVE_SIGNAL_H-# include <signal.h>-#endif--#if HAVE_TIME_H-# include <time.h>-#endif--#if HAVE_TERMIOS_H-# include <termios.h>-#endif--#if HAVE_STRING_H-# include <string.h>-#endif--#if HAVE_CTYPE_H-# include <ctype.h>-#endif--#if HAVE_INTTYPES_H-# include <inttypes.h>-#else-# if HAVE_STDINT_H-#  include <stdint.h>-# endif-#endif--#if defined(HAVE_GL_GL_H)-# include <GL/gl.h>-#elif defined(HAVE_OPENGL_GL_H)-# include <OpenGL/gl.h>-#endif--#if defined(HAVE_AL_AL_H)-# include <AL/al.h>-#elif defined(HAVE_OPENAL_AL_H)-# include <OpenAL/al.h>-#endif--#if defined(HAVE_AL_ALC_H)-# include <AL/alc.h>-#elif defined(HAVE_OPENAL_ALC_H)-# include <OpenAL/alc.h>-#endif--#if HAVE_SYS_RESOURCE_H-# include <sys/resource.h>-#endif--#include <stdlib.h>--typedef short testing;--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",-           (int)(sizeof(testing)*8));-  } else {-    fprintf(f,"%s\n",-           (sizeof(testing) >  sizeof(double)) ? "LDouble" :-           (sizeof(testing) == sizeof(double)) ? "Double"  : "Float");-  }-  fclose(f);-  exit(0);-}-_ACEOF-if ac_fn_c_try_run "$LINENO"; then :-  fptools_cv_htype_short=`cat conftestval`-else-  fptools_cv_htype_short=NotReallyAType; fptools_cv_htype_sup_short=no-fi-rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \-  conftest.$ac_objext conftest.beam conftest.$ac_ext-fi--CPPFLAGS="$fp_check_htype_save_cppflags"-fi- if test "$fptools_cv_htype_sup_short" = yes; then-  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $fptools_cv_htype_short" >&5-$as_echo "$fptools_cv_htype_short" >&6; }--cat >>confdefs.h <<_ACEOF-#define HTYPE_SHORT $fptools_cv_htype_short-_ACEOF--else-  { $as_echo "$as_me:${as_lineno-$LINENO}: result: not supported" >&5-$as_echo "not supported" >&6; }-fi--{ $as_echo "$as_me:${as_lineno-$LINENO}: checking Haskell type for unsigned short" >&5-$as_echo_n "checking Haskell type for unsigned short... " >&6; }-if test "${fptools_cv_htype_unsigned_short+set}" = set; then :-  $as_echo_n "(cached) " >&6-else-  fptools_cv_htype_sup_unsigned_short=yes-fp_check_htype_save_cppflags="$CPPFLAGS"-CPPFLAGS="$CPPFLAGS $X_CFLAGS"-if test "$cross_compiling" = yes; then :-  fptools_cv_htype_unsigned_short=NotReallyATypeCross; fptools_cv_htype_sup_unsigned_short=no-else-  cat confdefs.h - <<_ACEOF >conftest.$ac_ext-/* end confdefs.h.  */-#include <stdio.h>-#include <stddef.h>--#if HAVE_SYS_TYPES_H-# include <sys/types.h>-#endif--#if HAVE_UNISTD_H-# include <unistd.h>-#endif--#if HAVE_SYS_STAT_H-# include <sys/stat.h>-#endif--#if HAVE_FCNTL_H-# include <fcntl.h>-#endif--#if HAVE_SIGNAL_H-# include <signal.h>-#endif--#if HAVE_TIME_H-# include <time.h>-#endif--#if HAVE_TERMIOS_H-# include <termios.h>-#endif--#if HAVE_STRING_H-# include <string.h>-#endif--#if HAVE_CTYPE_H-# include <ctype.h>-#endif--#if HAVE_INTTYPES_H-# include <inttypes.h>-#else-# if HAVE_STDINT_H-#  include <stdint.h>-# endif-#endif--#if defined(HAVE_GL_GL_H)-# include <GL/gl.h>-#elif defined(HAVE_OPENGL_GL_H)-# include <OpenGL/gl.h>-#endif--#if defined(HAVE_AL_AL_H)-# include <AL/al.h>-#elif defined(HAVE_OPENAL_AL_H)-# include <OpenAL/al.h>-#endif--#if defined(HAVE_AL_ALC_H)-# include <AL/alc.h>-#elif defined(HAVE_OPENAL_ALC_H)-# include <OpenAL/alc.h>-#endif--#if HAVE_SYS_RESOURCE_H-# include <sys/resource.h>-#endif--#include <stdlib.h>--typedef unsigned short testing;--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",-           (int)(sizeof(testing)*8));-  } else {-    fprintf(f,"%s\n",-           (sizeof(testing) >  sizeof(double)) ? "LDouble" :-           (sizeof(testing) == sizeof(double)) ? "Double"  : "Float");-  }-  fclose(f);-  exit(0);-}-_ACEOF-if ac_fn_c_try_run "$LINENO"; then :-  fptools_cv_htype_unsigned_short=`cat conftestval`-else-  fptools_cv_htype_unsigned_short=NotReallyAType; fptools_cv_htype_sup_unsigned_short=no-fi-rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \-  conftest.$ac_objext conftest.beam conftest.$ac_ext-fi--CPPFLAGS="$fp_check_htype_save_cppflags"-fi- if test "$fptools_cv_htype_sup_unsigned_short" = yes; then-  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $fptools_cv_htype_unsigned_short" >&5-$as_echo "$fptools_cv_htype_unsigned_short" >&6; }--cat >>confdefs.h <<_ACEOF-#define HTYPE_UNSIGNED_SHORT $fptools_cv_htype_unsigned_short-_ACEOF--else-  { $as_echo "$as_me:${as_lineno-$LINENO}: result: not supported" >&5-$as_echo "not supported" >&6; }-fi--{ $as_echo "$as_me:${as_lineno-$LINENO}: checking Haskell type for int" >&5-$as_echo_n "checking Haskell type for int... " >&6; }-if test "${fptools_cv_htype_int+set}" = set; then :-  $as_echo_n "(cached) " >&6-else-  fptools_cv_htype_sup_int=yes-fp_check_htype_save_cppflags="$CPPFLAGS"-CPPFLAGS="$CPPFLAGS $X_CFLAGS"-if test "$cross_compiling" = yes; then :-  fptools_cv_htype_int=NotReallyATypeCross; fptools_cv_htype_sup_int=no-else-  cat confdefs.h - <<_ACEOF >conftest.$ac_ext-/* end confdefs.h.  */-#include <stdio.h>-#include <stddef.h>--#if HAVE_SYS_TYPES_H-# include <sys/types.h>-#endif--#if HAVE_UNISTD_H-# include <unistd.h>-#endif--#if HAVE_SYS_STAT_H-# include <sys/stat.h>-#endif--#if HAVE_FCNTL_H-# include <fcntl.h>-#endif--#if HAVE_SIGNAL_H-# include <signal.h>-#endif--#if HAVE_TIME_H-# include <time.h>-#endif--#if HAVE_TERMIOS_H-# include <termios.h>-#endif--#if HAVE_STRING_H-# include <string.h>-#endif--#if HAVE_CTYPE_H-# include <ctype.h>-#endif--#if HAVE_INTTYPES_H-# include <inttypes.h>-#else-# if HAVE_STDINT_H-#  include <stdint.h>-# endif-#endif--#if defined(HAVE_GL_GL_H)-# include <GL/gl.h>-#elif defined(HAVE_OPENGL_GL_H)-# include <OpenGL/gl.h>-#endif--#if defined(HAVE_AL_AL_H)-# include <AL/al.h>-#elif defined(HAVE_OPENAL_AL_H)-# include <OpenAL/al.h>-#endif--#if defined(HAVE_AL_ALC_H)-# include <AL/alc.h>-#elif defined(HAVE_OPENAL_ALC_H)-# include <OpenAL/alc.h>-#endif--#if HAVE_SYS_RESOURCE_H-# include <sys/resource.h>-#endif--#include <stdlib.h>--typedef int testing;--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",-           (int)(sizeof(testing)*8));-  } else {-    fprintf(f,"%s\n",-           (sizeof(testing) >  sizeof(double)) ? "LDouble" :-           (sizeof(testing) == sizeof(double)) ? "Double"  : "Float");-  }-  fclose(f);-  exit(0);-}-_ACEOF-if ac_fn_c_try_run "$LINENO"; then :-  fptools_cv_htype_int=`cat conftestval`-else-  fptools_cv_htype_int=NotReallyAType; fptools_cv_htype_sup_int=no-fi-rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \-  conftest.$ac_objext conftest.beam conftest.$ac_ext-fi--CPPFLAGS="$fp_check_htype_save_cppflags"-fi- if test "$fptools_cv_htype_sup_int" = yes; then-  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $fptools_cv_htype_int" >&5-$as_echo "$fptools_cv_htype_int" >&6; }--cat >>confdefs.h <<_ACEOF-#define HTYPE_INT $fptools_cv_htype_int-_ACEOF--else-  { $as_echo "$as_me:${as_lineno-$LINENO}: result: not supported" >&5-$as_echo "not supported" >&6; }-fi--{ $as_echo "$as_me:${as_lineno-$LINENO}: checking Haskell type for unsigned int" >&5-$as_echo_n "checking Haskell type for unsigned int... " >&6; }-if test "${fptools_cv_htype_unsigned_int+set}" = set; then :-  $as_echo_n "(cached) " >&6-else-  fptools_cv_htype_sup_unsigned_int=yes-fp_check_htype_save_cppflags="$CPPFLAGS"-CPPFLAGS="$CPPFLAGS $X_CFLAGS"-if test "$cross_compiling" = yes; then :-  fptools_cv_htype_unsigned_int=NotReallyATypeCross; fptools_cv_htype_sup_unsigned_int=no-else-  cat confdefs.h - <<_ACEOF >conftest.$ac_ext-/* end confdefs.h.  */-#include <stdio.h>-#include <stddef.h>--#if HAVE_SYS_TYPES_H-# include <sys/types.h>-#endif--#if HAVE_UNISTD_H-# include <unistd.h>-#endif--#if HAVE_SYS_STAT_H-# include <sys/stat.h>-#endif--#if HAVE_FCNTL_H-# include <fcntl.h>-#endif--#if HAVE_SIGNAL_H-# include <signal.h>-#endif--#if HAVE_TIME_H-# include <time.h>-#endif--#if HAVE_TERMIOS_H-# include <termios.h>-#endif--#if HAVE_STRING_H-# include <string.h>-#endif--#if HAVE_CTYPE_H-# include <ctype.h>-#endif--#if HAVE_INTTYPES_H-# include <inttypes.h>-#else-# if HAVE_STDINT_H-#  include <stdint.h>-# endif-#endif--#if defined(HAVE_GL_GL_H)-# include <GL/gl.h>-#elif defined(HAVE_OPENGL_GL_H)-# include <OpenGL/gl.h>-#endif--#if defined(HAVE_AL_AL_H)-# include <AL/al.h>-#elif defined(HAVE_OPENAL_AL_H)-# include <OpenAL/al.h>-#endif--#if defined(HAVE_AL_ALC_H)-# include <AL/alc.h>-#elif defined(HAVE_OPENAL_ALC_H)-# include <OpenAL/alc.h>-#endif--#if HAVE_SYS_RESOURCE_H-# include <sys/resource.h>-#endif--#include <stdlib.h>--typedef unsigned int testing;--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",-           (int)(sizeof(testing)*8));-  } else {-    fprintf(f,"%s\n",-           (sizeof(testing) >  sizeof(double)) ? "LDouble" :-           (sizeof(testing) == sizeof(double)) ? "Double"  : "Float");-  }-  fclose(f);-  exit(0);-}-_ACEOF-if ac_fn_c_try_run "$LINENO"; then :-  fptools_cv_htype_unsigned_int=`cat conftestval`-else-  fptools_cv_htype_unsigned_int=NotReallyAType; fptools_cv_htype_sup_unsigned_int=no-fi-rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \-  conftest.$ac_objext conftest.beam conftest.$ac_ext-fi--CPPFLAGS="$fp_check_htype_save_cppflags"-fi- if test "$fptools_cv_htype_sup_unsigned_int" = yes; then-  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $fptools_cv_htype_unsigned_int" >&5-$as_echo "$fptools_cv_htype_unsigned_int" >&6; }--cat >>confdefs.h <<_ACEOF-#define HTYPE_UNSIGNED_INT $fptools_cv_htype_unsigned_int-_ACEOF--else-  { $as_echo "$as_me:${as_lineno-$LINENO}: result: not supported" >&5-$as_echo "not supported" >&6; }-fi--{ $as_echo "$as_me:${as_lineno-$LINENO}: checking Haskell type for long" >&5-$as_echo_n "checking Haskell type for long... " >&6; }-if test "${fptools_cv_htype_long+set}" = set; then :-  $as_echo_n "(cached) " >&6-else-  fptools_cv_htype_sup_long=yes-fp_check_htype_save_cppflags="$CPPFLAGS"-CPPFLAGS="$CPPFLAGS $X_CFLAGS"-if test "$cross_compiling" = yes; then :-  fptools_cv_htype_long=NotReallyATypeCross; fptools_cv_htype_sup_long=no-else-  cat confdefs.h - <<_ACEOF >conftest.$ac_ext-/* end confdefs.h.  */-#include <stdio.h>-#include <stddef.h>--#if HAVE_SYS_TYPES_H-# include <sys/types.h>-#endif--#if HAVE_UNISTD_H-# include <unistd.h>-#endif--#if HAVE_SYS_STAT_H-# include <sys/stat.h>-#endif--#if HAVE_FCNTL_H-# include <fcntl.h>-#endif--#if HAVE_SIGNAL_H-# include <signal.h>-#endif--#if HAVE_TIME_H-# include <time.h>-#endif--#if HAVE_TERMIOS_H-# include <termios.h>-#endif--#if HAVE_STRING_H-# include <string.h>-#endif--#if HAVE_CTYPE_H-# include <ctype.h>-#endif--#if HAVE_INTTYPES_H-# include <inttypes.h>-#else-# if HAVE_STDINT_H-#  include <stdint.h>-# endif-#endif--#if defined(HAVE_GL_GL_H)-# include <GL/gl.h>-#elif defined(HAVE_OPENGL_GL_H)-# include <OpenGL/gl.h>-#endif--#if defined(HAVE_AL_AL_H)-# include <AL/al.h>-#elif defined(HAVE_OPENAL_AL_H)-# include <OpenAL/al.h>-#endif--#if defined(HAVE_AL_ALC_H)-# include <AL/alc.h>-#elif defined(HAVE_OPENAL_ALC_H)-# include <OpenAL/alc.h>-#endif--#if HAVE_SYS_RESOURCE_H-# include <sys/resource.h>-#endif--#include <stdlib.h>--typedef long testing;--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",-           (int)(sizeof(testing)*8));-  } else {-    fprintf(f,"%s\n",-           (sizeof(testing) >  sizeof(double)) ? "LDouble" :-           (sizeof(testing) == sizeof(double)) ? "Double"  : "Float");-  }-  fclose(f);-  exit(0);-}-_ACEOF-if ac_fn_c_try_run "$LINENO"; then :-  fptools_cv_htype_long=`cat conftestval`-else-  fptools_cv_htype_long=NotReallyAType; fptools_cv_htype_sup_long=no-fi-rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \-  conftest.$ac_objext conftest.beam conftest.$ac_ext-fi--CPPFLAGS="$fp_check_htype_save_cppflags"-fi- if test "$fptools_cv_htype_sup_long" = yes; then-  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $fptools_cv_htype_long" >&5-$as_echo "$fptools_cv_htype_long" >&6; }--cat >>confdefs.h <<_ACEOF-#define HTYPE_LONG $fptools_cv_htype_long-_ACEOF--else-  { $as_echo "$as_me:${as_lineno-$LINENO}: result: not supported" >&5-$as_echo "not supported" >&6; }-fi--{ $as_echo "$as_me:${as_lineno-$LINENO}: checking Haskell type for unsigned long" >&5-$as_echo_n "checking Haskell type for unsigned long... " >&6; }-if test "${fptools_cv_htype_unsigned_long+set}" = set; then :-  $as_echo_n "(cached) " >&6-else-  fptools_cv_htype_sup_unsigned_long=yes-fp_check_htype_save_cppflags="$CPPFLAGS"-CPPFLAGS="$CPPFLAGS $X_CFLAGS"-if test "$cross_compiling" = yes; then :-  fptools_cv_htype_unsigned_long=NotReallyATypeCross; fptools_cv_htype_sup_unsigned_long=no-else-  cat confdefs.h - <<_ACEOF >conftest.$ac_ext-/* end confdefs.h.  */-#include <stdio.h>-#include <stddef.h>--#if HAVE_SYS_TYPES_H-# include <sys/types.h>-#endif--#if HAVE_UNISTD_H-# include <unistd.h>-#endif--#if HAVE_SYS_STAT_H-# include <sys/stat.h>-#endif--#if HAVE_FCNTL_H-# include <fcntl.h>-#endif--#if HAVE_SIGNAL_H-# include <signal.h>-#endif--#if HAVE_TIME_H-# include <time.h>-#endif--#if HAVE_TERMIOS_H-# include <termios.h>-#endif--#if HAVE_STRING_H-# include <string.h>-#endif--#if HAVE_CTYPE_H-# include <ctype.h>-#endif--#if HAVE_INTTYPES_H-# include <inttypes.h>-#else-# if HAVE_STDINT_H-#  include <stdint.h>-# endif-#endif--#if defined(HAVE_GL_GL_H)-# include <GL/gl.h>-#elif defined(HAVE_OPENGL_GL_H)-# include <OpenGL/gl.h>-#endif--#if defined(HAVE_AL_AL_H)-# include <AL/al.h>-#elif defined(HAVE_OPENAL_AL_H)-# include <OpenAL/al.h>-#endif--#if defined(HAVE_AL_ALC_H)-# include <AL/alc.h>-#elif defined(HAVE_OPENAL_ALC_H)-# include <OpenAL/alc.h>-#endif--#if HAVE_SYS_RESOURCE_H-# include <sys/resource.h>-#endif--#include <stdlib.h>--typedef unsigned long testing;--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",-           (int)(sizeof(testing)*8));-  } else {-    fprintf(f,"%s\n",-           (sizeof(testing) >  sizeof(double)) ? "LDouble" :-           (sizeof(testing) == sizeof(double)) ? "Double"  : "Float");-  }-  fclose(f);-  exit(0);-}-_ACEOF-if ac_fn_c_try_run "$LINENO"; then :-  fptools_cv_htype_unsigned_long=`cat conftestval`-else-  fptools_cv_htype_unsigned_long=NotReallyAType; fptools_cv_htype_sup_unsigned_long=no-fi-rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \-  conftest.$ac_objext conftest.beam conftest.$ac_ext-fi--CPPFLAGS="$fp_check_htype_save_cppflags"-fi- if test "$fptools_cv_htype_sup_unsigned_long" = yes; then-  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $fptools_cv_htype_unsigned_long" >&5-$as_echo "$fptools_cv_htype_unsigned_long" >&6; }--cat >>confdefs.h <<_ACEOF-#define HTYPE_UNSIGNED_LONG $fptools_cv_htype_unsigned_long-_ACEOF--else-  { $as_echo "$as_me:${as_lineno-$LINENO}: result: not supported" >&5-$as_echo "not supported" >&6; }-fi--if test "$ac_cv_type_long_long" = yes; then-{ $as_echo "$as_me:${as_lineno-$LINENO}: checking Haskell type for long long" >&5-$as_echo_n "checking Haskell type for long long... " >&6; }-if test "${fptools_cv_htype_long_long+set}" = set; then :-  $as_echo_n "(cached) " >&6-else-  fptools_cv_htype_sup_long_long=yes-fp_check_htype_save_cppflags="$CPPFLAGS"-CPPFLAGS="$CPPFLAGS $X_CFLAGS"-if test "$cross_compiling" = yes; then :-  fptools_cv_htype_long_long=NotReallyATypeCross; fptools_cv_htype_sup_long_long=no-else-  cat confdefs.h - <<_ACEOF >conftest.$ac_ext-/* end confdefs.h.  */-#include <stdio.h>-#include <stddef.h>--#if HAVE_SYS_TYPES_H-# include <sys/types.h>-#endif--#if HAVE_UNISTD_H-# include <unistd.h>-#endif--#if HAVE_SYS_STAT_H-# include <sys/stat.h>-#endif--#if HAVE_FCNTL_H-# include <fcntl.h>-#endif--#if HAVE_SIGNAL_H-# include <signal.h>-#endif--#if HAVE_TIME_H-# include <time.h>-#endif--#if HAVE_TERMIOS_H-# include <termios.h>-#endif--#if HAVE_STRING_H-# include <string.h>-#endif--#if HAVE_CTYPE_H-# include <ctype.h>-#endif--#if HAVE_INTTYPES_H-# include <inttypes.h>-#else-# if HAVE_STDINT_H-#  include <stdint.h>-# endif-#endif--#if defined(HAVE_GL_GL_H)-# include <GL/gl.h>-#elif defined(HAVE_OPENGL_GL_H)-# include <OpenGL/gl.h>-#endif--#if defined(HAVE_AL_AL_H)-# include <AL/al.h>-#elif defined(HAVE_OPENAL_AL_H)-# include <OpenAL/al.h>-#endif--#if defined(HAVE_AL_ALC_H)-# include <AL/alc.h>-#elif defined(HAVE_OPENAL_ALC_H)-# include <OpenAL/alc.h>-#endif--#if HAVE_SYS_RESOURCE_H-# include <sys/resource.h>-#endif--#include <stdlib.h>--typedef long long testing;--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",-           (int)(sizeof(testing)*8));-  } else {-    fprintf(f,"%s\n",-           (sizeof(testing) >  sizeof(double)) ? "LDouble" :-           (sizeof(testing) == sizeof(double)) ? "Double"  : "Float");-  }-  fclose(f);-  exit(0);-}-_ACEOF-if ac_fn_c_try_run "$LINENO"; then :-  fptools_cv_htype_long_long=`cat conftestval`-else-  fptools_cv_htype_long_long=NotReallyAType; fptools_cv_htype_sup_long_long=no-fi-rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \-  conftest.$ac_objext conftest.beam conftest.$ac_ext-fi--CPPFLAGS="$fp_check_htype_save_cppflags"-fi- if test "$fptools_cv_htype_sup_long_long" = yes; then-  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $fptools_cv_htype_long_long" >&5-$as_echo "$fptools_cv_htype_long_long" >&6; }--cat >>confdefs.h <<_ACEOF-#define HTYPE_LONG_LONG $fptools_cv_htype_long_long-_ACEOF--else-  { $as_echo "$as_me:${as_lineno-$LINENO}: result: not supported" >&5-$as_echo "not supported" >&6; }-fi--{ $as_echo "$as_me:${as_lineno-$LINENO}: checking Haskell type for unsigned long long" >&5-$as_echo_n "checking Haskell type for unsigned long long... " >&6; }-if test "${fptools_cv_htype_unsigned_long_long+set}" = set; then :-  $as_echo_n "(cached) " >&6-else-  fptools_cv_htype_sup_unsigned_long_long=yes-fp_check_htype_save_cppflags="$CPPFLAGS"-CPPFLAGS="$CPPFLAGS $X_CFLAGS"-if test "$cross_compiling" = yes; then :-  fptools_cv_htype_unsigned_long_long=NotReallyATypeCross; fptools_cv_htype_sup_unsigned_long_long=no-else-  cat confdefs.h - <<_ACEOF >conftest.$ac_ext-/* end confdefs.h.  */-#include <stdio.h>-#include <stddef.h>--#if HAVE_SYS_TYPES_H-# include <sys/types.h>-#endif--#if HAVE_UNISTD_H-# include <unistd.h>-#endif--#if HAVE_SYS_STAT_H-# include <sys/stat.h>-#endif--#if HAVE_FCNTL_H-# include <fcntl.h>-#endif--#if HAVE_SIGNAL_H-# include <signal.h>-#endif--#if HAVE_TIME_H-# include <time.h>-#endif--#if HAVE_TERMIOS_H-# include <termios.h>-#endif--#if HAVE_STRING_H-# include <string.h>-#endif--#if HAVE_CTYPE_H-# include <ctype.h>-#endif--#if HAVE_INTTYPES_H-# include <inttypes.h>-#else-# if HAVE_STDINT_H-#  include <stdint.h>-# endif-#endif--#if defined(HAVE_GL_GL_H)-# include <GL/gl.h>-#elif defined(HAVE_OPENGL_GL_H)-# include <OpenGL/gl.h>-#endif--#if defined(HAVE_AL_AL_H)-# include <AL/al.h>-#elif defined(HAVE_OPENAL_AL_H)-# include <OpenAL/al.h>-#endif--#if defined(HAVE_AL_ALC_H)-# include <AL/alc.h>-#elif defined(HAVE_OPENAL_ALC_H)-# include <OpenAL/alc.h>-#endif--#if HAVE_SYS_RESOURCE_H-# include <sys/resource.h>-#endif--#include <stdlib.h>--typedef unsigned long long testing;--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",-           (int)(sizeof(testing)*8));-  } else {-    fprintf(f,"%s\n",-           (sizeof(testing) >  sizeof(double)) ? "LDouble" :-           (sizeof(testing) == sizeof(double)) ? "Double"  : "Float");-  }-  fclose(f);-  exit(0);-}-_ACEOF-if ac_fn_c_try_run "$LINENO"; then :-  fptools_cv_htype_unsigned_long_long=`cat conftestval`-else-  fptools_cv_htype_unsigned_long_long=NotReallyAType; fptools_cv_htype_sup_unsigned_long_long=no-fi-rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \-  conftest.$ac_objext conftest.beam conftest.$ac_ext-fi--CPPFLAGS="$fp_check_htype_save_cppflags"-fi- if test "$fptools_cv_htype_sup_unsigned_long_long" = yes; then-  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $fptools_cv_htype_unsigned_long_long" >&5-$as_echo "$fptools_cv_htype_unsigned_long_long" >&6; }--cat >>confdefs.h <<_ACEOF-#define HTYPE_UNSIGNED_LONG_LONG $fptools_cv_htype_unsigned_long_long-_ACEOF--else-  { $as_echo "$as_me:${as_lineno-$LINENO}: result: not supported" >&5-$as_echo "not supported" >&6; }-fi--fi-{ $as_echo "$as_me:${as_lineno-$LINENO}: checking Haskell type for float" >&5-$as_echo_n "checking Haskell type for float... " >&6; }-if test "${fptools_cv_htype_float+set}" = set; then :-  $as_echo_n "(cached) " >&6-else-  fptools_cv_htype_sup_float=yes-fp_check_htype_save_cppflags="$CPPFLAGS"-CPPFLAGS="$CPPFLAGS $X_CFLAGS"-if test "$cross_compiling" = yes; then :-  fptools_cv_htype_float=NotReallyATypeCross; fptools_cv_htype_sup_float=no-else-  cat confdefs.h - <<_ACEOF >conftest.$ac_ext-/* end confdefs.h.  */-#include <stdio.h>-#include <stddef.h>--#if HAVE_SYS_TYPES_H-# include <sys/types.h>-#endif--#if HAVE_UNISTD_H-# include <unistd.h>-#endif--#if HAVE_SYS_STAT_H-# include <sys/stat.h>-#endif--#if HAVE_FCNTL_H-# include <fcntl.h>-#endif--#if HAVE_SIGNAL_H-# include <signal.h>-#endif--#if HAVE_TIME_H-# include <time.h>-#endif--#if HAVE_TERMIOS_H-# include <termios.h>-#endif--#if HAVE_STRING_H-# include <string.h>-#endif--#if HAVE_CTYPE_H-# include <ctype.h>-#endif--#if HAVE_INTTYPES_H-# include <inttypes.h>-#else-# if HAVE_STDINT_H-#  include <stdint.h>-# endif-#endif--#if defined(HAVE_GL_GL_H)-# include <GL/gl.h>-#elif defined(HAVE_OPENGL_GL_H)-# include <OpenGL/gl.h>-#endif--#if defined(HAVE_AL_AL_H)-# include <AL/al.h>-#elif defined(HAVE_OPENAL_AL_H)-# include <OpenAL/al.h>-#endif--#if defined(HAVE_AL_ALC_H)-# include <AL/alc.h>-#elif defined(HAVE_OPENAL_ALC_H)-# include <OpenAL/alc.h>-#endif--#if HAVE_SYS_RESOURCE_H-# include <sys/resource.h>-#endif--#include <stdlib.h>--typedef float testing;--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",-           (int)(sizeof(testing)*8));-  } else {-    fprintf(f,"%s\n",-           (sizeof(testing) >  sizeof(double)) ? "LDouble" :-           (sizeof(testing) == sizeof(double)) ? "Double"  : "Float");-  }-  fclose(f);-  exit(0);-}-_ACEOF-if ac_fn_c_try_run "$LINENO"; then :-  fptools_cv_htype_float=`cat conftestval`-else-  fptools_cv_htype_float=NotReallyAType; fptools_cv_htype_sup_float=no-fi-rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \-  conftest.$ac_objext conftest.beam conftest.$ac_ext-fi--CPPFLAGS="$fp_check_htype_save_cppflags"-fi- if test "$fptools_cv_htype_sup_float" = yes; then-  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $fptools_cv_htype_float" >&5-$as_echo "$fptools_cv_htype_float" >&6; }--cat >>confdefs.h <<_ACEOF-#define HTYPE_FLOAT $fptools_cv_htype_float-_ACEOF--else-  { $as_echo "$as_me:${as_lineno-$LINENO}: result: not supported" >&5-$as_echo "not supported" >&6; }-fi--{ $as_echo "$as_me:${as_lineno-$LINENO}: checking Haskell type for double" >&5-$as_echo_n "checking Haskell type for double... " >&6; }-if test "${fptools_cv_htype_double+set}" = set; then :-  $as_echo_n "(cached) " >&6-else-  fptools_cv_htype_sup_double=yes-fp_check_htype_save_cppflags="$CPPFLAGS"-CPPFLAGS="$CPPFLAGS $X_CFLAGS"-if test "$cross_compiling" = yes; then :-  fptools_cv_htype_double=NotReallyATypeCross; fptools_cv_htype_sup_double=no-else-  cat confdefs.h - <<_ACEOF >conftest.$ac_ext-/* end confdefs.h.  */-#include <stdio.h>-#include <stddef.h>--#if HAVE_SYS_TYPES_H-# include <sys/types.h>-#endif--#if HAVE_UNISTD_H-# include <unistd.h>-#endif--#if HAVE_SYS_STAT_H-# include <sys/stat.h>-#endif--#if HAVE_FCNTL_H-# include <fcntl.h>-#endif--#if HAVE_SIGNAL_H-# include <signal.h>-#endif--#if HAVE_TIME_H-# include <time.h>-#endif--#if HAVE_TERMIOS_H-# include <termios.h>-#endif--#if HAVE_STRING_H-# include <string.h>-#endif--#if HAVE_CTYPE_H-# include <ctype.h>-#endif--#if HAVE_INTTYPES_H-# include <inttypes.h>-#else-# if HAVE_STDINT_H-#  include <stdint.h>-# endif-#endif--#if defined(HAVE_GL_GL_H)-# include <GL/gl.h>-#elif defined(HAVE_OPENGL_GL_H)-# include <OpenGL/gl.h>-#endif--#if defined(HAVE_AL_AL_H)-# include <AL/al.h>-#elif defined(HAVE_OPENAL_AL_H)-# include <OpenAL/al.h>-#endif--#if defined(HAVE_AL_ALC_H)-# include <AL/alc.h>-#elif defined(HAVE_OPENAL_ALC_H)-# include <OpenAL/alc.h>-#endif--#if HAVE_SYS_RESOURCE_H-# include <sys/resource.h>-#endif--#include <stdlib.h>--typedef double testing;--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",-           (int)(sizeof(testing)*8));-  } else {-    fprintf(f,"%s\n",-           (sizeof(testing) >  sizeof(double)) ? "LDouble" :-           (sizeof(testing) == sizeof(double)) ? "Double"  : "Float");-  }-  fclose(f);-  exit(0);-}-_ACEOF-if ac_fn_c_try_run "$LINENO"; then :-  fptools_cv_htype_double=`cat conftestval`-else-  fptools_cv_htype_double=NotReallyAType; fptools_cv_htype_sup_double=no-fi-rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \-  conftest.$ac_objext conftest.beam conftest.$ac_ext-fi--CPPFLAGS="$fp_check_htype_save_cppflags"-fi- if test "$fptools_cv_htype_sup_double" = yes; then-  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $fptools_cv_htype_double" >&5-$as_echo "$fptools_cv_htype_double" >&6; }--cat >>confdefs.h <<_ACEOF-#define HTYPE_DOUBLE $fptools_cv_htype_double-_ACEOF--else-  { $as_echo "$as_me:${as_lineno-$LINENO}: result: not supported" >&5-$as_echo "not supported" >&6; }-fi--{ $as_echo "$as_me:${as_lineno-$LINENO}: checking Haskell type for ptrdiff_t" >&5-$as_echo_n "checking Haskell type for ptrdiff_t... " >&6; }-if test "${fptools_cv_htype_ptrdiff_t+set}" = set; then :-  $as_echo_n "(cached) " >&6-else-  fptools_cv_htype_sup_ptrdiff_t=yes-fp_check_htype_save_cppflags="$CPPFLAGS"-CPPFLAGS="$CPPFLAGS $X_CFLAGS"-if test "$cross_compiling" = yes; then :-  fptools_cv_htype_ptrdiff_t=NotReallyATypeCross; fptools_cv_htype_sup_ptrdiff_t=no-else-  cat confdefs.h - <<_ACEOF >conftest.$ac_ext-/* end confdefs.h.  */-#include <stdio.h>-#include <stddef.h>--#if HAVE_SYS_TYPES_H-# include <sys/types.h>-#endif--#if HAVE_UNISTD_H-# include <unistd.h>-#endif--#if HAVE_SYS_STAT_H-# include <sys/stat.h>-#endif--#if HAVE_FCNTL_H-# include <fcntl.h>-#endif--#if HAVE_SIGNAL_H-# include <signal.h>-#endif--#if HAVE_TIME_H-# include <time.h>-#endif--#if HAVE_TERMIOS_H-# include <termios.h>-#endif--#if HAVE_STRING_H-# include <string.h>-#endif--#if HAVE_CTYPE_H-# include <ctype.h>-#endif--#if HAVE_INTTYPES_H-# include <inttypes.h>-#else-# if HAVE_STDINT_H-#  include <stdint.h>-# endif-#endif--#if defined(HAVE_GL_GL_H)-# include <GL/gl.h>-#elif defined(HAVE_OPENGL_GL_H)-# include <OpenGL/gl.h>-#endif--#if defined(HAVE_AL_AL_H)-# include <AL/al.h>-#elif defined(HAVE_OPENAL_AL_H)-# include <OpenAL/al.h>-#endif--#if defined(HAVE_AL_ALC_H)-# include <AL/alc.h>-#elif defined(HAVE_OPENAL_ALC_H)-# include <OpenAL/alc.h>-#endif--#if HAVE_SYS_RESOURCE_H-# include <sys/resource.h>-#endif--#include <stdlib.h>--typedef ptrdiff_t testing;--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",-           (int)(sizeof(testing)*8));-  } else {-    fprintf(f,"%s\n",-           (sizeof(testing) >  sizeof(double)) ? "LDouble" :-           (sizeof(testing) == sizeof(double)) ? "Double"  : "Float");-  }-  fclose(f);-  exit(0);-}-_ACEOF-if ac_fn_c_try_run "$LINENO"; then :-  fptools_cv_htype_ptrdiff_t=`cat conftestval`-else-  fptools_cv_htype_ptrdiff_t=NotReallyAType; fptools_cv_htype_sup_ptrdiff_t=no-fi-rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \-  conftest.$ac_objext conftest.beam conftest.$ac_ext-fi--CPPFLAGS="$fp_check_htype_save_cppflags"-fi- if test "$fptools_cv_htype_sup_ptrdiff_t" = yes; then-  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $fptools_cv_htype_ptrdiff_t" >&5-$as_echo "$fptools_cv_htype_ptrdiff_t" >&6; }--cat >>confdefs.h <<_ACEOF-#define HTYPE_PTRDIFF_T $fptools_cv_htype_ptrdiff_t-_ACEOF--else-  { $as_echo "$as_me:${as_lineno-$LINENO}: result: not supported" >&5-$as_echo "not supported" >&6; }-fi--{ $as_echo "$as_me:${as_lineno-$LINENO}: checking Haskell type for size_t" >&5-$as_echo_n "checking Haskell type for size_t... " >&6; }-if test "${fptools_cv_htype_size_t+set}" = set; then :-  $as_echo_n "(cached) " >&6-else-  fptools_cv_htype_sup_size_t=yes-fp_check_htype_save_cppflags="$CPPFLAGS"-CPPFLAGS="$CPPFLAGS $X_CFLAGS"-if test "$cross_compiling" = yes; then :-  fptools_cv_htype_size_t=NotReallyATypeCross; fptools_cv_htype_sup_size_t=no-else-  cat confdefs.h - <<_ACEOF >conftest.$ac_ext-/* end confdefs.h.  */-#include <stdio.h>-#include <stddef.h>--#if HAVE_SYS_TYPES_H-# include <sys/types.h>-#endif--#if HAVE_UNISTD_H-# include <unistd.h>-#endif--#if HAVE_SYS_STAT_H-# include <sys/stat.h>-#endif--#if HAVE_FCNTL_H-# include <fcntl.h>-#endif--#if HAVE_SIGNAL_H-# include <signal.h>-#endif--#if HAVE_TIME_H-# include <time.h>-#endif--#if HAVE_TERMIOS_H-# include <termios.h>-#endif--#if HAVE_STRING_H-# include <string.h>-#endif--#if HAVE_CTYPE_H-# include <ctype.h>-#endif--#if HAVE_INTTYPES_H-# include <inttypes.h>-#else-# if HAVE_STDINT_H-#  include <stdint.h>-# endif-#endif--#if defined(HAVE_GL_GL_H)-# include <GL/gl.h>-#elif defined(HAVE_OPENGL_GL_H)-# include <OpenGL/gl.h>-#endif--#if defined(HAVE_AL_AL_H)-# include <AL/al.h>-#elif defined(HAVE_OPENAL_AL_H)-# include <OpenAL/al.h>-#endif--#if defined(HAVE_AL_ALC_H)-# include <AL/alc.h>-#elif defined(HAVE_OPENAL_ALC_H)-# include <OpenAL/alc.h>-#endif--#if HAVE_SYS_RESOURCE_H-# include <sys/resource.h>-#endif--#include <stdlib.h>--typedef size_t testing;--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",-           (int)(sizeof(testing)*8));-  } else {-    fprintf(f,"%s\n",-           (sizeof(testing) >  sizeof(double)) ? "LDouble" :-           (sizeof(testing) == sizeof(double)) ? "Double"  : "Float");-  }-  fclose(f);-  exit(0);-}-_ACEOF-if ac_fn_c_try_run "$LINENO"; then :-  fptools_cv_htype_size_t=`cat conftestval`-else-  fptools_cv_htype_size_t=NotReallyAType; fptools_cv_htype_sup_size_t=no-fi-rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \-  conftest.$ac_objext conftest.beam conftest.$ac_ext-fi--CPPFLAGS="$fp_check_htype_save_cppflags"-fi- if test "$fptools_cv_htype_sup_size_t" = yes; then-  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $fptools_cv_htype_size_t" >&5-$as_echo "$fptools_cv_htype_size_t" >&6; }--cat >>confdefs.h <<_ACEOF-#define HTYPE_SIZE_T $fptools_cv_htype_size_t-_ACEOF--else-  { $as_echo "$as_me:${as_lineno-$LINENO}: result: not supported" >&5-$as_echo "not supported" >&6; }-fi--{ $as_echo "$as_me:${as_lineno-$LINENO}: checking Haskell type for wchar_t" >&5-$as_echo_n "checking Haskell type for wchar_t... " >&6; }-if test "${fptools_cv_htype_wchar_t+set}" = set; then :-  $as_echo_n "(cached) " >&6-else-  fptools_cv_htype_sup_wchar_t=yes-fp_check_htype_save_cppflags="$CPPFLAGS"-CPPFLAGS="$CPPFLAGS $X_CFLAGS"-if test "$cross_compiling" = yes; then :-  fptools_cv_htype_wchar_t=NotReallyATypeCross; fptools_cv_htype_sup_wchar_t=no-else-  cat confdefs.h - <<_ACEOF >conftest.$ac_ext-/* end confdefs.h.  */-#include <stdio.h>-#include <stddef.h>--#if HAVE_SYS_TYPES_H-# include <sys/types.h>-#endif--#if HAVE_UNISTD_H-# include <unistd.h>-#endif--#if HAVE_SYS_STAT_H-# include <sys/stat.h>-#endif--#if HAVE_FCNTL_H-# include <fcntl.h>-#endif--#if HAVE_SIGNAL_H-# include <signal.h>-#endif--#if HAVE_TIME_H-# include <time.h>-#endif--#if HAVE_TERMIOS_H-# include <termios.h>-#endif--#if HAVE_STRING_H-# include <string.h>-#endif--#if HAVE_CTYPE_H-# include <ctype.h>-#endif--#if HAVE_INTTYPES_H-# include <inttypes.h>-#else-# if HAVE_STDINT_H-#  include <stdint.h>-# endif-#endif--#if defined(HAVE_GL_GL_H)-# include <GL/gl.h>-#elif defined(HAVE_OPENGL_GL_H)-# include <OpenGL/gl.h>-#endif--#if defined(HAVE_AL_AL_H)-# include <AL/al.h>-#elif defined(HAVE_OPENAL_AL_H)-# include <OpenAL/al.h>-#endif--#if defined(HAVE_AL_ALC_H)-# include <AL/alc.h>-#elif defined(HAVE_OPENAL_ALC_H)-# include <OpenAL/alc.h>-#endif--#if HAVE_SYS_RESOURCE_H-# include <sys/resource.h>-#endif--#include <stdlib.h>--typedef wchar_t testing;--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",-           (int)(sizeof(testing)*8));-  } else {-    fprintf(f,"%s\n",-           (sizeof(testing) >  sizeof(double)) ? "LDouble" :-           (sizeof(testing) == sizeof(double)) ? "Double"  : "Float");-  }-  fclose(f);-  exit(0);-}-_ACEOF-if ac_fn_c_try_run "$LINENO"; then :-  fptools_cv_htype_wchar_t=`cat conftestval`-else-  fptools_cv_htype_wchar_t=NotReallyAType; fptools_cv_htype_sup_wchar_t=no-fi-rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \-  conftest.$ac_objext conftest.beam conftest.$ac_ext-fi--CPPFLAGS="$fp_check_htype_save_cppflags"-fi- if test "$fptools_cv_htype_sup_wchar_t" = yes; then-  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $fptools_cv_htype_wchar_t" >&5-$as_echo "$fptools_cv_htype_wchar_t" >&6; }--cat >>confdefs.h <<_ACEOF-#define HTYPE_WCHAR_T $fptools_cv_htype_wchar_t-_ACEOF--else-  { $as_echo "$as_me:${as_lineno-$LINENO}: result: not supported" >&5-$as_echo "not supported" >&6; }-fi--# Int32 is a HACK for non-ISO C compilers-{ $as_echo "$as_me:${as_lineno-$LINENO}: checking Haskell type for sig_atomic_t" >&5-$as_echo_n "checking Haskell type for sig_atomic_t... " >&6; }-if test "${fptools_cv_htype_sig_atomic_t+set}" = set; then :-  $as_echo_n "(cached) " >&6-else-  fptools_cv_htype_sup_sig_atomic_t=yes-fp_check_htype_save_cppflags="$CPPFLAGS"-CPPFLAGS="$CPPFLAGS $X_CFLAGS"-if test "$cross_compiling" = yes; then :-  fptools_cv_htype_sig_atomic_t=NotReallyATypeCross; fptools_cv_htype_sup_sig_atomic_t=no-else-  cat confdefs.h - <<_ACEOF >conftest.$ac_ext-/* end confdefs.h.  */-#include <stdio.h>-#include <stddef.h>--#if HAVE_SYS_TYPES_H-# include <sys/types.h>-#endif--#if HAVE_UNISTD_H-# include <unistd.h>-#endif--#if HAVE_SYS_STAT_H-# include <sys/stat.h>-#endif--#if HAVE_FCNTL_H-# include <fcntl.h>-#endif--#if HAVE_SIGNAL_H-# include <signal.h>-#endif--#if HAVE_TIME_H-# include <time.h>-#endif--#if HAVE_TERMIOS_H-# include <termios.h>-#endif--#if HAVE_STRING_H-# include <string.h>-#endif--#if HAVE_CTYPE_H-# include <ctype.h>-#endif--#if HAVE_INTTYPES_H-# include <inttypes.h>-#else-# if HAVE_STDINT_H-#  include <stdint.h>-# endif-#endif--#if defined(HAVE_GL_GL_H)-# include <GL/gl.h>-#elif defined(HAVE_OPENGL_GL_H)-# include <OpenGL/gl.h>-#endif--#if defined(HAVE_AL_AL_H)-# include <AL/al.h>-#elif defined(HAVE_OPENAL_AL_H)-# include <OpenAL/al.h>-#endif--#if defined(HAVE_AL_ALC_H)-# include <AL/alc.h>-#elif defined(HAVE_OPENAL_ALC_H)-# include <OpenAL/alc.h>-#endif--#if HAVE_SYS_RESOURCE_H-# include <sys/resource.h>-#endif--#include <stdlib.h>--typedef sig_atomic_t testing;--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",-           (int)(sizeof(testing)*8));-  } else {-    fprintf(f,"%s\n",-           (sizeof(testing) >  sizeof(double)) ? "LDouble" :-           (sizeof(testing) == sizeof(double)) ? "Double"  : "Float");-  }-  fclose(f);-  exit(0);-}-_ACEOF-if ac_fn_c_try_run "$LINENO"; then :-  fptools_cv_htype_sig_atomic_t=`cat conftestval`-else-  fptools_cv_htype_sig_atomic_t=Int32-fi-rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \-  conftest.$ac_objext conftest.beam conftest.$ac_ext-fi--CPPFLAGS="$fp_check_htype_save_cppflags"-fi- if test "$fptools_cv_htype_sup_sig_atomic_t" = yes; then-  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $fptools_cv_htype_sig_atomic_t" >&5-$as_echo "$fptools_cv_htype_sig_atomic_t" >&6; }--cat >>confdefs.h <<_ACEOF-#define HTYPE_SIG_ATOMIC_T $fptools_cv_htype_sig_atomic_t-_ACEOF--else-  { $as_echo "$as_me:${as_lineno-$LINENO}: result: not supported" >&5-$as_echo "not supported" >&6; }-fi--{ $as_echo "$as_me:${as_lineno-$LINENO}: checking Haskell type for clock_t" >&5-$as_echo_n "checking Haskell type for clock_t... " >&6; }-if test "${fptools_cv_htype_clock_t+set}" = set; then :-  $as_echo_n "(cached) " >&6-else-  fptools_cv_htype_sup_clock_t=yes-fp_check_htype_save_cppflags="$CPPFLAGS"-CPPFLAGS="$CPPFLAGS $X_CFLAGS"-if test "$cross_compiling" = yes; then :-  fptools_cv_htype_clock_t=NotReallyATypeCross; fptools_cv_htype_sup_clock_t=no-else-  cat confdefs.h - <<_ACEOF >conftest.$ac_ext-/* end confdefs.h.  */-#include <stdio.h>-#include <stddef.h>--#if HAVE_SYS_TYPES_H-# include <sys/types.h>-#endif--#if HAVE_UNISTD_H-# include <unistd.h>-#endif--#if HAVE_SYS_STAT_H-# include <sys/stat.h>-#endif--#if HAVE_FCNTL_H-# include <fcntl.h>-#endif--#if HAVE_SIGNAL_H-# include <signal.h>-#endif--#if HAVE_TIME_H-# include <time.h>-#endif--#if HAVE_TERMIOS_H-# include <termios.h>-#endif--#if HAVE_STRING_H-# include <string.h>-#endif--#if HAVE_CTYPE_H-# include <ctype.h>-#endif--#if HAVE_INTTYPES_H-# include <inttypes.h>-#else-# if HAVE_STDINT_H-#  include <stdint.h>-# endif-#endif--#if defined(HAVE_GL_GL_H)-# include <GL/gl.h>-#elif defined(HAVE_OPENGL_GL_H)-# include <OpenGL/gl.h>-#endif--#if defined(HAVE_AL_AL_H)-# include <AL/al.h>-#elif defined(HAVE_OPENAL_AL_H)-# include <OpenAL/al.h>-#endif--#if defined(HAVE_AL_ALC_H)-# include <AL/alc.h>-#elif defined(HAVE_OPENAL_ALC_H)-# include <OpenAL/alc.h>-#endif--#if HAVE_SYS_RESOURCE_H-# include <sys/resource.h>-#endif--#include <stdlib.h>--typedef clock_t testing;--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",-           (int)(sizeof(testing)*8));-  } else {-    fprintf(f,"%s\n",-           (sizeof(testing) >  sizeof(double)) ? "LDouble" :-           (sizeof(testing) == sizeof(double)) ? "Double"  : "Float");-  }-  fclose(f);-  exit(0);-}-_ACEOF-if ac_fn_c_try_run "$LINENO"; then :-  fptools_cv_htype_clock_t=`cat conftestval`-else-  fptools_cv_htype_clock_t=NotReallyAType; fptools_cv_htype_sup_clock_t=no-fi-rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \-  conftest.$ac_objext conftest.beam conftest.$ac_ext-fi--CPPFLAGS="$fp_check_htype_save_cppflags"-fi- if test "$fptools_cv_htype_sup_clock_t" = yes; then-  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $fptools_cv_htype_clock_t" >&5-$as_echo "$fptools_cv_htype_clock_t" >&6; }--cat >>confdefs.h <<_ACEOF-#define HTYPE_CLOCK_T $fptools_cv_htype_clock_t-_ACEOF--else-  { $as_echo "$as_me:${as_lineno-$LINENO}: result: not supported" >&5-$as_echo "not supported" >&6; }-fi--{ $as_echo "$as_me:${as_lineno-$LINENO}: checking Haskell type for time_t" >&5-$as_echo_n "checking Haskell type for time_t... " >&6; }-if test "${fptools_cv_htype_time_t+set}" = set; then :-  $as_echo_n "(cached) " >&6-else-  fptools_cv_htype_sup_time_t=yes-fp_check_htype_save_cppflags="$CPPFLAGS"-CPPFLAGS="$CPPFLAGS $X_CFLAGS"-if test "$cross_compiling" = yes; then :-  fptools_cv_htype_time_t=NotReallyATypeCross; fptools_cv_htype_sup_time_t=no-else-  cat confdefs.h - <<_ACEOF >conftest.$ac_ext-/* end confdefs.h.  */-#include <stdio.h>-#include <stddef.h>--#if HAVE_SYS_TYPES_H-# include <sys/types.h>-#endif--#if HAVE_UNISTD_H-# include <unistd.h>-#endif--#if HAVE_SYS_STAT_H-# include <sys/stat.h>-#endif--#if HAVE_FCNTL_H-# include <fcntl.h>-#endif--#if HAVE_SIGNAL_H-# include <signal.h>-#endif--#if HAVE_TIME_H-# include <time.h>-#endif--#if HAVE_TERMIOS_H-# include <termios.h>-#endif--#if HAVE_STRING_H-# include <string.h>-#endif--#if HAVE_CTYPE_H-# include <ctype.h>-#endif--#if HAVE_INTTYPES_H-# include <inttypes.h>-#else-# if HAVE_STDINT_H-#  include <stdint.h>-# endif-#endif--#if defined(HAVE_GL_GL_H)-# include <GL/gl.h>-#elif defined(HAVE_OPENGL_GL_H)-# include <OpenGL/gl.h>-#endif--#if defined(HAVE_AL_AL_H)-# include <AL/al.h>-#elif defined(HAVE_OPENAL_AL_H)-# include <OpenAL/al.h>-#endif--#if defined(HAVE_AL_ALC_H)-# include <AL/alc.h>-#elif defined(HAVE_OPENAL_ALC_H)-# include <OpenAL/alc.h>-#endif--#if HAVE_SYS_RESOURCE_H-# include <sys/resource.h>-#endif--#include <stdlib.h>--typedef time_t testing;--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",-           (int)(sizeof(testing)*8));-  } else {-    fprintf(f,"%s\n",-           (sizeof(testing) >  sizeof(double)) ? "LDouble" :-           (sizeof(testing) == sizeof(double)) ? "Double"  : "Float");-  }-  fclose(f);-  exit(0);-}-_ACEOF-if ac_fn_c_try_run "$LINENO"; then :-  fptools_cv_htype_time_t=`cat conftestval`-else-  fptools_cv_htype_time_t=NotReallyAType; fptools_cv_htype_sup_time_t=no-fi-rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \-  conftest.$ac_objext conftest.beam conftest.$ac_ext-fi--CPPFLAGS="$fp_check_htype_save_cppflags"-fi- if test "$fptools_cv_htype_sup_time_t" = yes; then-  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $fptools_cv_htype_time_t" >&5-$as_echo "$fptools_cv_htype_time_t" >&6; }--cat >>confdefs.h <<_ACEOF-#define HTYPE_TIME_T $fptools_cv_htype_time_t-_ACEOF--else-  { $as_echo "$as_me:${as_lineno-$LINENO}: result: not supported" >&5-$as_echo "not supported" >&6; }-fi--{ $as_echo "$as_me:${as_lineno-$LINENO}: checking Haskell type for dev_t" >&5-$as_echo_n "checking Haskell type for dev_t... " >&6; }-if test "${fptools_cv_htype_dev_t+set}" = set; then :-  $as_echo_n "(cached) " >&6-else-  fptools_cv_htype_sup_dev_t=yes-fp_check_htype_save_cppflags="$CPPFLAGS"-CPPFLAGS="$CPPFLAGS $X_CFLAGS"-if test "$cross_compiling" = yes; then :-  fptools_cv_htype_dev_t=NotReallyATypeCross; fptools_cv_htype_sup_dev_t=no-else-  cat confdefs.h - <<_ACEOF >conftest.$ac_ext-/* end confdefs.h.  */-#include <stdio.h>-#include <stddef.h>--#if HAVE_SYS_TYPES_H-# include <sys/types.h>-#endif--#if HAVE_UNISTD_H-# include <unistd.h>-#endif--#if HAVE_SYS_STAT_H-# include <sys/stat.h>-#endif--#if HAVE_FCNTL_H-# include <fcntl.h>-#endif--#if HAVE_SIGNAL_H-# include <signal.h>-#endif--#if HAVE_TIME_H-# include <time.h>-#endif--#if HAVE_TERMIOS_H-# include <termios.h>-#endif--#if HAVE_STRING_H-# include <string.h>-#endif--#if HAVE_CTYPE_H-# include <ctype.h>-#endif--#if HAVE_INTTYPES_H-# include <inttypes.h>-#else-# if HAVE_STDINT_H-#  include <stdint.h>-# endif-#endif--#if defined(HAVE_GL_GL_H)-# include <GL/gl.h>-#elif defined(HAVE_OPENGL_GL_H)-# include <OpenGL/gl.h>-#endif--#if defined(HAVE_AL_AL_H)-# include <AL/al.h>-#elif defined(HAVE_OPENAL_AL_H)-# include <OpenAL/al.h>-#endif--#if defined(HAVE_AL_ALC_H)-# include <AL/alc.h>-#elif defined(HAVE_OPENAL_ALC_H)-# include <OpenAL/alc.h>-#endif--#if HAVE_SYS_RESOURCE_H-# include <sys/resource.h>-#endif--#include <stdlib.h>--typedef dev_t testing;--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",-           (int)(sizeof(testing)*8));-  } else {-    fprintf(f,"%s\n",-           (sizeof(testing) >  sizeof(double)) ? "LDouble" :-           (sizeof(testing) == sizeof(double)) ? "Double"  : "Float");-  }-  fclose(f);-  exit(0);-}-_ACEOF-if ac_fn_c_try_run "$LINENO"; then :-  fptools_cv_htype_dev_t=`cat conftestval`-else-  fptools_cv_htype_dev_t=Word32-fi-rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \-  conftest.$ac_objext conftest.beam conftest.$ac_ext-fi--CPPFLAGS="$fp_check_htype_save_cppflags"-fi- if test "$fptools_cv_htype_sup_dev_t" = yes; then-  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $fptools_cv_htype_dev_t" >&5-$as_echo "$fptools_cv_htype_dev_t" >&6; }--cat >>confdefs.h <<_ACEOF-#define HTYPE_DEV_T $fptools_cv_htype_dev_t-_ACEOF--else-  { $as_echo "$as_me:${as_lineno-$LINENO}: result: not supported" >&5-$as_echo "not supported" >&6; }-fi--{ $as_echo "$as_me:${as_lineno-$LINENO}: checking Haskell type for ino_t" >&5-$as_echo_n "checking Haskell type for ino_t... " >&6; }-if test "${fptools_cv_htype_ino_t+set}" = set; then :-  $as_echo_n "(cached) " >&6-else-  fptools_cv_htype_sup_ino_t=yes-fp_check_htype_save_cppflags="$CPPFLAGS"-CPPFLAGS="$CPPFLAGS $X_CFLAGS"-if test "$cross_compiling" = yes; then :-  fptools_cv_htype_ino_t=NotReallyATypeCross; fptools_cv_htype_sup_ino_t=no-else-  cat confdefs.h - <<_ACEOF >conftest.$ac_ext-/* end confdefs.h.  */-#include <stdio.h>-#include <stddef.h>--#if HAVE_SYS_TYPES_H-# include <sys/types.h>-#endif--#if HAVE_UNISTD_H-# include <unistd.h>-#endif--#if HAVE_SYS_STAT_H-# include <sys/stat.h>-#endif--#if HAVE_FCNTL_H-# include <fcntl.h>-#endif--#if HAVE_SIGNAL_H-# include <signal.h>-#endif--#if HAVE_TIME_H-# include <time.h>-#endif--#if HAVE_TERMIOS_H-# include <termios.h>-#endif--#if HAVE_STRING_H-# include <string.h>-#endif--#if HAVE_CTYPE_H-# include <ctype.h>-#endif--#if HAVE_INTTYPES_H-# include <inttypes.h>-#else-# if HAVE_STDINT_H-#  include <stdint.h>-# endif-#endif--#if defined(HAVE_GL_GL_H)-# include <GL/gl.h>-#elif defined(HAVE_OPENGL_GL_H)-# include <OpenGL/gl.h>-#endif--#if defined(HAVE_AL_AL_H)-# include <AL/al.h>-#elif defined(HAVE_OPENAL_AL_H)-# include <OpenAL/al.h>-#endif--#if defined(HAVE_AL_ALC_H)-# include <AL/alc.h>-#elif defined(HAVE_OPENAL_ALC_H)-# include <OpenAL/alc.h>-#endif--#if HAVE_SYS_RESOURCE_H-# include <sys/resource.h>-#endif--#include <stdlib.h>--typedef ino_t testing;--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",-           (int)(sizeof(testing)*8));-  } else {-    fprintf(f,"%s\n",-           (sizeof(testing) >  sizeof(double)) ? "LDouble" :-           (sizeof(testing) == sizeof(double)) ? "Double"  : "Float");-  }-  fclose(f);-  exit(0);-}-_ACEOF-if ac_fn_c_try_run "$LINENO"; then :-  fptools_cv_htype_ino_t=`cat conftestval`-else-  fptools_cv_htype_ino_t=NotReallyAType; fptools_cv_htype_sup_ino_t=no-fi-rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \-  conftest.$ac_objext conftest.beam conftest.$ac_ext-fi--CPPFLAGS="$fp_check_htype_save_cppflags"-fi- if test "$fptools_cv_htype_sup_ino_t" = yes; then-  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $fptools_cv_htype_ino_t" >&5-$as_echo "$fptools_cv_htype_ino_t" >&6; }--cat >>confdefs.h <<_ACEOF-#define HTYPE_INO_T $fptools_cv_htype_ino_t-_ACEOF--else-  { $as_echo "$as_me:${as_lineno-$LINENO}: result: not supported" >&5-$as_echo "not supported" >&6; }-fi--{ $as_echo "$as_me:${as_lineno-$LINENO}: checking Haskell type for mode_t" >&5-$as_echo_n "checking Haskell type for mode_t... " >&6; }-if test "${fptools_cv_htype_mode_t+set}" = set; then :-  $as_echo_n "(cached) " >&6-else-  fptools_cv_htype_sup_mode_t=yes-fp_check_htype_save_cppflags="$CPPFLAGS"-CPPFLAGS="$CPPFLAGS $X_CFLAGS"-if test "$cross_compiling" = yes; then :-  fptools_cv_htype_mode_t=NotReallyATypeCross; fptools_cv_htype_sup_mode_t=no-else-  cat confdefs.h - <<_ACEOF >conftest.$ac_ext-/* end confdefs.h.  */-#include <stdio.h>-#include <stddef.h>--#if HAVE_SYS_TYPES_H-# include <sys/types.h>-#endif--#if HAVE_UNISTD_H-# include <unistd.h>-#endif--#if HAVE_SYS_STAT_H-# include <sys/stat.h>-#endif--#if HAVE_FCNTL_H-# include <fcntl.h>-#endif--#if HAVE_SIGNAL_H-# include <signal.h>-#endif--#if HAVE_TIME_H-# include <time.h>-#endif--#if HAVE_TERMIOS_H-# include <termios.h>-#endif--#if HAVE_STRING_H-# include <string.h>-#endif--#if HAVE_CTYPE_H-# include <ctype.h>-#endif--#if HAVE_INTTYPES_H-# include <inttypes.h>-#else-# if HAVE_STDINT_H-#  include <stdint.h>-# endif-#endif--#if defined(HAVE_GL_GL_H)-# include <GL/gl.h>-#elif defined(HAVE_OPENGL_GL_H)-# include <OpenGL/gl.h>-#endif--#if defined(HAVE_AL_AL_H)-# include <AL/al.h>-#elif defined(HAVE_OPENAL_AL_H)-# include <OpenAL/al.h>-#endif--#if defined(HAVE_AL_ALC_H)-# include <AL/alc.h>-#elif defined(HAVE_OPENAL_ALC_H)-# include <OpenAL/alc.h>-#endif--#if HAVE_SYS_RESOURCE_H-# include <sys/resource.h>-#endif--#include <stdlib.h>--typedef mode_t testing;--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",-           (int)(sizeof(testing)*8));-  } else {-    fprintf(f,"%s\n",-           (sizeof(testing) >  sizeof(double)) ? "LDouble" :-           (sizeof(testing) == sizeof(double)) ? "Double"  : "Float");-  }-  fclose(f);-  exit(0);-}-_ACEOF-if ac_fn_c_try_run "$LINENO"; then :-  fptools_cv_htype_mode_t=`cat conftestval`-else-  fptools_cv_htype_mode_t=NotReallyAType; fptools_cv_htype_sup_mode_t=no-fi-rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \-  conftest.$ac_objext conftest.beam conftest.$ac_ext-fi--CPPFLAGS="$fp_check_htype_save_cppflags"-fi- if test "$fptools_cv_htype_sup_mode_t" = yes; then-  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $fptools_cv_htype_mode_t" >&5-$as_echo "$fptools_cv_htype_mode_t" >&6; }--cat >>confdefs.h <<_ACEOF-#define HTYPE_MODE_T $fptools_cv_htype_mode_t-_ACEOF--else-  { $as_echo "$as_me:${as_lineno-$LINENO}: result: not supported" >&5-$as_echo "not supported" >&6; }-fi--{ $as_echo "$as_me:${as_lineno-$LINENO}: checking Haskell type for off_t" >&5-$as_echo_n "checking Haskell type for off_t... " >&6; }-if test "${fptools_cv_htype_off_t+set}" = set; then :-  $as_echo_n "(cached) " >&6-else-  fptools_cv_htype_sup_off_t=yes-fp_check_htype_save_cppflags="$CPPFLAGS"-CPPFLAGS="$CPPFLAGS $X_CFLAGS"-if test "$cross_compiling" = yes; then :-  fptools_cv_htype_off_t=NotReallyATypeCross; fptools_cv_htype_sup_off_t=no-else-  cat confdefs.h - <<_ACEOF >conftest.$ac_ext-/* end confdefs.h.  */-#include <stdio.h>-#include <stddef.h>--#if HAVE_SYS_TYPES_H-# include <sys/types.h>-#endif--#if HAVE_UNISTD_H-# include <unistd.h>-#endif--#if HAVE_SYS_STAT_H-# include <sys/stat.h>-#endif--#if HAVE_FCNTL_H-# include <fcntl.h>-#endif--#if HAVE_SIGNAL_H-# include <signal.h>-#endif--#if HAVE_TIME_H-# include <time.h>-#endif--#if HAVE_TERMIOS_H-# include <termios.h>-#endif--#if HAVE_STRING_H-# include <string.h>-#endif--#if HAVE_CTYPE_H-# include <ctype.h>-#endif--#if HAVE_INTTYPES_H-# include <inttypes.h>-#else-# if HAVE_STDINT_H-#  include <stdint.h>-# endif-#endif--#if defined(HAVE_GL_GL_H)-# include <GL/gl.h>-#elif defined(HAVE_OPENGL_GL_H)-# include <OpenGL/gl.h>-#endif--#if defined(HAVE_AL_AL_H)-# include <AL/al.h>-#elif defined(HAVE_OPENAL_AL_H)-# include <OpenAL/al.h>-#endif--#if defined(HAVE_AL_ALC_H)-# include <AL/alc.h>-#elif defined(HAVE_OPENAL_ALC_H)-# include <OpenAL/alc.h>-#endif--#if HAVE_SYS_RESOURCE_H-# include <sys/resource.h>-#endif--#include <stdlib.h>--typedef off_t testing;--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",-           (int)(sizeof(testing)*8));-  } else {-    fprintf(f,"%s\n",-           (sizeof(testing) >  sizeof(double)) ? "LDouble" :-           (sizeof(testing) == sizeof(double)) ? "Double"  : "Float");-  }-  fclose(f);-  exit(0);-}-_ACEOF-if ac_fn_c_try_run "$LINENO"; then :-  fptools_cv_htype_off_t=`cat conftestval`-else-  fptools_cv_htype_off_t=NotReallyAType; fptools_cv_htype_sup_off_t=no-fi-rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \-  conftest.$ac_objext conftest.beam conftest.$ac_ext-fi--CPPFLAGS="$fp_check_htype_save_cppflags"-fi- if test "$fptools_cv_htype_sup_off_t" = yes; then-  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $fptools_cv_htype_off_t" >&5-$as_echo "$fptools_cv_htype_off_t" >&6; }--cat >>confdefs.h <<_ACEOF-#define HTYPE_OFF_T $fptools_cv_htype_off_t-_ACEOF--else-  { $as_echo "$as_me:${as_lineno-$LINENO}: result: not supported" >&5-$as_echo "not supported" >&6; }-fi--{ $as_echo "$as_me:${as_lineno-$LINENO}: checking Haskell type for pid_t" >&5-$as_echo_n "checking Haskell type for pid_t... " >&6; }-if test "${fptools_cv_htype_pid_t+set}" = set; then :-  $as_echo_n "(cached) " >&6-else-  fptools_cv_htype_sup_pid_t=yes-fp_check_htype_save_cppflags="$CPPFLAGS"-CPPFLAGS="$CPPFLAGS $X_CFLAGS"-if test "$cross_compiling" = yes; then :-  fptools_cv_htype_pid_t=NotReallyATypeCross; fptools_cv_htype_sup_pid_t=no-else-  cat confdefs.h - <<_ACEOF >conftest.$ac_ext-/* end confdefs.h.  */-#include <stdio.h>-#include <stddef.h>--#if HAVE_SYS_TYPES_H-# include <sys/types.h>-#endif--#if HAVE_UNISTD_H-# include <unistd.h>-#endif--#if HAVE_SYS_STAT_H-# include <sys/stat.h>-#endif--#if HAVE_FCNTL_H-# include <fcntl.h>-#endif--#if HAVE_SIGNAL_H-# include <signal.h>-#endif--#if HAVE_TIME_H-# include <time.h>-#endif--#if HAVE_TERMIOS_H-# include <termios.h>-#endif--#if HAVE_STRING_H-# include <string.h>-#endif--#if HAVE_CTYPE_H-# include <ctype.h>-#endif--#if HAVE_INTTYPES_H-# include <inttypes.h>-#else-# if HAVE_STDINT_H-#  include <stdint.h>-# endif-#endif--#if defined(HAVE_GL_GL_H)-# include <GL/gl.h>-#elif defined(HAVE_OPENGL_GL_H)-# include <OpenGL/gl.h>-#endif--#if defined(HAVE_AL_AL_H)-# include <AL/al.h>-#elif defined(HAVE_OPENAL_AL_H)-# include <OpenAL/al.h>-#endif--#if defined(HAVE_AL_ALC_H)-# include <AL/alc.h>-#elif defined(HAVE_OPENAL_ALC_H)-# include <OpenAL/alc.h>-#endif--#if HAVE_SYS_RESOURCE_H-# include <sys/resource.h>-#endif--#include <stdlib.h>--typedef pid_t testing;--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",-           (int)(sizeof(testing)*8));-  } else {-    fprintf(f,"%s\n",-           (sizeof(testing) >  sizeof(double)) ? "LDouble" :-           (sizeof(testing) == sizeof(double)) ? "Double"  : "Float");-  }-  fclose(f);-  exit(0);-}-_ACEOF-if ac_fn_c_try_run "$LINENO"; then :-  fptools_cv_htype_pid_t=`cat conftestval`-else-  fptools_cv_htype_pid_t=NotReallyAType; fptools_cv_htype_sup_pid_t=no-fi-rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \-  conftest.$ac_objext conftest.beam conftest.$ac_ext-fi--CPPFLAGS="$fp_check_htype_save_cppflags"-fi- if test "$fptools_cv_htype_sup_pid_t" = yes; then-  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $fptools_cv_htype_pid_t" >&5-$as_echo "$fptools_cv_htype_pid_t" >&6; }--cat >>confdefs.h <<_ACEOF-#define HTYPE_PID_T $fptools_cv_htype_pid_t-_ACEOF--else-  { $as_echo "$as_me:${as_lineno-$LINENO}: result: not supported" >&5-$as_echo "not supported" >&6; }-fi--{ $as_echo "$as_me:${as_lineno-$LINENO}: checking Haskell type for gid_t" >&5-$as_echo_n "checking Haskell type for gid_t... " >&6; }-if test "${fptools_cv_htype_gid_t+set}" = set; then :-  $as_echo_n "(cached) " >&6-else-  fptools_cv_htype_sup_gid_t=yes-fp_check_htype_save_cppflags="$CPPFLAGS"-CPPFLAGS="$CPPFLAGS $X_CFLAGS"-if test "$cross_compiling" = yes; then :-  fptools_cv_htype_gid_t=NotReallyATypeCross; fptools_cv_htype_sup_gid_t=no-else-  cat confdefs.h - <<_ACEOF >conftest.$ac_ext-/* end confdefs.h.  */-#include <stdio.h>-#include <stddef.h>--#if HAVE_SYS_TYPES_H-# include <sys/types.h>-#endif--#if HAVE_UNISTD_H-# include <unistd.h>-#endif--#if HAVE_SYS_STAT_H-# include <sys/stat.h>-#endif--#if HAVE_FCNTL_H-# include <fcntl.h>-#endif--#if HAVE_SIGNAL_H-# include <signal.h>-#endif--#if HAVE_TIME_H-# include <time.h>-#endif--#if HAVE_TERMIOS_H-# include <termios.h>-#endif--#if HAVE_STRING_H-# include <string.h>-#endif--#if HAVE_CTYPE_H-# include <ctype.h>-#endif--#if HAVE_INTTYPES_H-# include <inttypes.h>-#else-# if HAVE_STDINT_H-#  include <stdint.h>-# endif-#endif--#if defined(HAVE_GL_GL_H)-# include <GL/gl.h>-#elif defined(HAVE_OPENGL_GL_H)-# include <OpenGL/gl.h>-#endif--#if defined(HAVE_AL_AL_H)-# include <AL/al.h>-#elif defined(HAVE_OPENAL_AL_H)-# include <OpenAL/al.h>-#endif--#if defined(HAVE_AL_ALC_H)-# include <AL/alc.h>-#elif defined(HAVE_OPENAL_ALC_H)-# include <OpenAL/alc.h>-#endif--#if HAVE_SYS_RESOURCE_H-# include <sys/resource.h>-#endif--#include <stdlib.h>--typedef gid_t testing;--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",-           (int)(sizeof(testing)*8));-  } else {-    fprintf(f,"%s\n",-           (sizeof(testing) >  sizeof(double)) ? "LDouble" :-           (sizeof(testing) == sizeof(double)) ? "Double"  : "Float");-  }-  fclose(f);-  exit(0);-}-_ACEOF-if ac_fn_c_try_run "$LINENO"; then :-  fptools_cv_htype_gid_t=`cat conftestval`-else-  fptools_cv_htype_gid_t=NotReallyAType; fptools_cv_htype_sup_gid_t=no-fi-rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \-  conftest.$ac_objext conftest.beam conftest.$ac_ext-fi--CPPFLAGS="$fp_check_htype_save_cppflags"-fi- if test "$fptools_cv_htype_sup_gid_t" = yes; then-  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $fptools_cv_htype_gid_t" >&5-$as_echo "$fptools_cv_htype_gid_t" >&6; }--cat >>confdefs.h <<_ACEOF-#define HTYPE_GID_T $fptools_cv_htype_gid_t-_ACEOF--else-  { $as_echo "$as_me:${as_lineno-$LINENO}: result: not supported" >&5-$as_echo "not supported" >&6; }-fi--{ $as_echo "$as_me:${as_lineno-$LINENO}: checking Haskell type for uid_t" >&5-$as_echo_n "checking Haskell type for uid_t... " >&6; }-if test "${fptools_cv_htype_uid_t+set}" = set; then :-  $as_echo_n "(cached) " >&6-else-  fptools_cv_htype_sup_uid_t=yes-fp_check_htype_save_cppflags="$CPPFLAGS"-CPPFLAGS="$CPPFLAGS $X_CFLAGS"-if test "$cross_compiling" = yes; then :-  fptools_cv_htype_uid_t=NotReallyATypeCross; fptools_cv_htype_sup_uid_t=no-else-  cat confdefs.h - <<_ACEOF >conftest.$ac_ext-/* end confdefs.h.  */-#include <stdio.h>-#include <stddef.h>--#if HAVE_SYS_TYPES_H-# include <sys/types.h>-#endif--#if HAVE_UNISTD_H-# include <unistd.h>-#endif--#if HAVE_SYS_STAT_H-# include <sys/stat.h>-#endif--#if HAVE_FCNTL_H-# include <fcntl.h>-#endif--#if HAVE_SIGNAL_H-# include <signal.h>-#endif--#if HAVE_TIME_H-# include <time.h>-#endif--#if HAVE_TERMIOS_H-# include <termios.h>-#endif--#if HAVE_STRING_H-# include <string.h>-#endif--#if HAVE_CTYPE_H-# include <ctype.h>-#endif--#if HAVE_INTTYPES_H-# include <inttypes.h>-#else-# if HAVE_STDINT_H-#  include <stdint.h>-# endif-#endif--#if defined(HAVE_GL_GL_H)-# include <GL/gl.h>-#elif defined(HAVE_OPENGL_GL_H)-# include <OpenGL/gl.h>-#endif--#if defined(HAVE_AL_AL_H)-# include <AL/al.h>-#elif defined(HAVE_OPENAL_AL_H)-# include <OpenAL/al.h>-#endif--#if defined(HAVE_AL_ALC_H)-# include <AL/alc.h>-#elif defined(HAVE_OPENAL_ALC_H)-# include <OpenAL/alc.h>-#endif--#if HAVE_SYS_RESOURCE_H-# include <sys/resource.h>-#endif--#include <stdlib.h>--typedef uid_t testing;--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",-           (int)(sizeof(testing)*8));-  } else {-    fprintf(f,"%s\n",-           (sizeof(testing) >  sizeof(double)) ? "LDouble" :-           (sizeof(testing) == sizeof(double)) ? "Double"  : "Float");-  }-  fclose(f);-  exit(0);-}-_ACEOF-if ac_fn_c_try_run "$LINENO"; then :-  fptools_cv_htype_uid_t=`cat conftestval`-else-  fptools_cv_htype_uid_t=NotReallyAType; fptools_cv_htype_sup_uid_t=no-fi-rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \-  conftest.$ac_objext conftest.beam conftest.$ac_ext-fi--CPPFLAGS="$fp_check_htype_save_cppflags"-fi- if test "$fptools_cv_htype_sup_uid_t" = yes; then-  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $fptools_cv_htype_uid_t" >&5-$as_echo "$fptools_cv_htype_uid_t" >&6; }--cat >>confdefs.h <<_ACEOF-#define HTYPE_UID_T $fptools_cv_htype_uid_t-_ACEOF--else-  { $as_echo "$as_me:${as_lineno-$LINENO}: result: not supported" >&5-$as_echo "not supported" >&6; }-fi--{ $as_echo "$as_me:${as_lineno-$LINENO}: checking Haskell type for cc_t" >&5-$as_echo_n "checking Haskell type for cc_t... " >&6; }-if test "${fptools_cv_htype_cc_t+set}" = set; then :-  $as_echo_n "(cached) " >&6-else-  fptools_cv_htype_sup_cc_t=yes-fp_check_htype_save_cppflags="$CPPFLAGS"-CPPFLAGS="$CPPFLAGS $X_CFLAGS"-if test "$cross_compiling" = yes; then :-  fptools_cv_htype_cc_t=NotReallyATypeCross; fptools_cv_htype_sup_cc_t=no-else-  cat confdefs.h - <<_ACEOF >conftest.$ac_ext-/* end confdefs.h.  */-#include <stdio.h>-#include <stddef.h>--#if HAVE_SYS_TYPES_H-# include <sys/types.h>-#endif--#if HAVE_UNISTD_H-# include <unistd.h>-#endif--#if HAVE_SYS_STAT_H-# include <sys/stat.h>-#endif--#if HAVE_FCNTL_H-# include <fcntl.h>-#endif--#if HAVE_SIGNAL_H-# include <signal.h>-#endif--#if HAVE_TIME_H-# include <time.h>-#endif--#if HAVE_TERMIOS_H-# include <termios.h>-#endif--#if HAVE_STRING_H-# include <string.h>-#endif--#if HAVE_CTYPE_H-# include <ctype.h>-#endif--#if HAVE_INTTYPES_H-# include <inttypes.h>-#else-# if HAVE_STDINT_H-#  include <stdint.h>-# endif-#endif--#if defined(HAVE_GL_GL_H)-# include <GL/gl.h>-#elif defined(HAVE_OPENGL_GL_H)-# include <OpenGL/gl.h>-#endif--#if defined(HAVE_AL_AL_H)-# include <AL/al.h>-#elif defined(HAVE_OPENAL_AL_H)-# include <OpenAL/al.h>-#endif--#if defined(HAVE_AL_ALC_H)-# include <AL/alc.h>-#elif defined(HAVE_OPENAL_ALC_H)-# include <OpenAL/alc.h>-#endif--#if HAVE_SYS_RESOURCE_H-# include <sys/resource.h>-#endif--#include <stdlib.h>--typedef cc_t testing;--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",-           (int)(sizeof(testing)*8));-  } else {-    fprintf(f,"%s\n",-           (sizeof(testing) >  sizeof(double)) ? "LDouble" :-           (sizeof(testing) == sizeof(double)) ? "Double"  : "Float");-  }-  fclose(f);-  exit(0);-}-_ACEOF-if ac_fn_c_try_run "$LINENO"; then :-  fptools_cv_htype_cc_t=`cat conftestval`-else-  fptools_cv_htype_cc_t=NotReallyAType; fptools_cv_htype_sup_cc_t=no-fi-rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \-  conftest.$ac_objext conftest.beam conftest.$ac_ext-fi--CPPFLAGS="$fp_check_htype_save_cppflags"-fi- if test "$fptools_cv_htype_sup_cc_t" = yes; then-  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $fptools_cv_htype_cc_t" >&5-$as_echo "$fptools_cv_htype_cc_t" >&6; }--cat >>confdefs.h <<_ACEOF-#define HTYPE_CC_T $fptools_cv_htype_cc_t-_ACEOF--else-  { $as_echo "$as_me:${as_lineno-$LINENO}: result: not supported" >&5-$as_echo "not supported" >&6; }-fi--{ $as_echo "$as_me:${as_lineno-$LINENO}: checking Haskell type for speed_t" >&5-$as_echo_n "checking Haskell type for speed_t... " >&6; }-if test "${fptools_cv_htype_speed_t+set}" = set; then :-  $as_echo_n "(cached) " >&6-else-  fptools_cv_htype_sup_speed_t=yes-fp_check_htype_save_cppflags="$CPPFLAGS"-CPPFLAGS="$CPPFLAGS $X_CFLAGS"-if test "$cross_compiling" = yes; then :-  fptools_cv_htype_speed_t=NotReallyATypeCross; fptools_cv_htype_sup_speed_t=no-else-  cat confdefs.h - <<_ACEOF >conftest.$ac_ext-/* end confdefs.h.  */-#include <stdio.h>-#include <stddef.h>--#if HAVE_SYS_TYPES_H-# include <sys/types.h>-#endif--#if HAVE_UNISTD_H-# include <unistd.h>-#endif--#if HAVE_SYS_STAT_H-# include <sys/stat.h>-#endif--#if HAVE_FCNTL_H-# include <fcntl.h>-#endif--#if HAVE_SIGNAL_H-# include <signal.h>-#endif--#if HAVE_TIME_H-# include <time.h>-#endif--#if HAVE_TERMIOS_H-# include <termios.h>-#endif--#if HAVE_STRING_H-# include <string.h>-#endif--#if HAVE_CTYPE_H-# include <ctype.h>-#endif--#if HAVE_INTTYPES_H-# include <inttypes.h>-#else-# if HAVE_STDINT_H-#  include <stdint.h>-# endif-#endif--#if defined(HAVE_GL_GL_H)-# include <GL/gl.h>-#elif defined(HAVE_OPENGL_GL_H)-# include <OpenGL/gl.h>-#endif--#if defined(HAVE_AL_AL_H)-# include <AL/al.h>-#elif defined(HAVE_OPENAL_AL_H)-# include <OpenAL/al.h>-#endif--#if defined(HAVE_AL_ALC_H)-# include <AL/alc.h>-#elif defined(HAVE_OPENAL_ALC_H)-# include <OpenAL/alc.h>-#endif--#if HAVE_SYS_RESOURCE_H-# include <sys/resource.h>-#endif--#include <stdlib.h>--typedef speed_t testing;--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",-           (int)(sizeof(testing)*8));-  } else {-    fprintf(f,"%s\n",-           (sizeof(testing) >  sizeof(double)) ? "LDouble" :-           (sizeof(testing) == sizeof(double)) ? "Double"  : "Float");-  }-  fclose(f);-  exit(0);-}-_ACEOF-if ac_fn_c_try_run "$LINENO"; then :-  fptools_cv_htype_speed_t=`cat conftestval`-else-  fptools_cv_htype_speed_t=NotReallyAType; fptools_cv_htype_sup_speed_t=no-fi-rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \-  conftest.$ac_objext conftest.beam conftest.$ac_ext-fi--CPPFLAGS="$fp_check_htype_save_cppflags"-fi- if test "$fptools_cv_htype_sup_speed_t" = yes; then-  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $fptools_cv_htype_speed_t" >&5-$as_echo "$fptools_cv_htype_speed_t" >&6; }--cat >>confdefs.h <<_ACEOF-#define HTYPE_SPEED_T $fptools_cv_htype_speed_t-_ACEOF--else-  { $as_echo "$as_me:${as_lineno-$LINENO}: result: not supported" >&5-$as_echo "not supported" >&6; }-fi--{ $as_echo "$as_me:${as_lineno-$LINENO}: checking Haskell type for tcflag_t" >&5-$as_echo_n "checking Haskell type for tcflag_t... " >&6; }-if test "${fptools_cv_htype_tcflag_t+set}" = set; then :-  $as_echo_n "(cached) " >&6-else-  fptools_cv_htype_sup_tcflag_t=yes-fp_check_htype_save_cppflags="$CPPFLAGS"-CPPFLAGS="$CPPFLAGS $X_CFLAGS"-if test "$cross_compiling" = yes; then :-  fptools_cv_htype_tcflag_t=NotReallyATypeCross; fptools_cv_htype_sup_tcflag_t=no-else-  cat confdefs.h - <<_ACEOF >conftest.$ac_ext-/* end confdefs.h.  */-#include <stdio.h>-#include <stddef.h>--#if HAVE_SYS_TYPES_H-# include <sys/types.h>-#endif--#if HAVE_UNISTD_H-# include <unistd.h>-#endif--#if HAVE_SYS_STAT_H-# include <sys/stat.h>-#endif--#if HAVE_FCNTL_H-# include <fcntl.h>-#endif--#if HAVE_SIGNAL_H-# include <signal.h>-#endif--#if HAVE_TIME_H-# include <time.h>-#endif--#if HAVE_TERMIOS_H-# include <termios.h>-#endif--#if HAVE_STRING_H-# include <string.h>-#endif--#if HAVE_CTYPE_H-# include <ctype.h>-#endif--#if HAVE_INTTYPES_H-# include <inttypes.h>-#else-# if HAVE_STDINT_H-#  include <stdint.h>-# endif-#endif--#if defined(HAVE_GL_GL_H)-# include <GL/gl.h>-#elif defined(HAVE_OPENGL_GL_H)-# include <OpenGL/gl.h>-#endif--#if defined(HAVE_AL_AL_H)-# include <AL/al.h>-#elif defined(HAVE_OPENAL_AL_H)-# include <OpenAL/al.h>-#endif--#if defined(HAVE_AL_ALC_H)-# include <AL/alc.h>-#elif defined(HAVE_OPENAL_ALC_H)-# include <OpenAL/alc.h>-#endif--#if HAVE_SYS_RESOURCE_H-# include <sys/resource.h>-#endif--#include <stdlib.h>--typedef tcflag_t testing;--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",-           (int)(sizeof(testing)*8));-  } else {-    fprintf(f,"%s\n",-           (sizeof(testing) >  sizeof(double)) ? "LDouble" :-           (sizeof(testing) == sizeof(double)) ? "Double"  : "Float");-  }-  fclose(f);-  exit(0);-}-_ACEOF-if ac_fn_c_try_run "$LINENO"; then :-  fptools_cv_htype_tcflag_t=`cat conftestval`-else-  fptools_cv_htype_tcflag_t=NotReallyAType; fptools_cv_htype_sup_tcflag_t=no-fi-rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \-  conftest.$ac_objext conftest.beam conftest.$ac_ext-fi--CPPFLAGS="$fp_check_htype_save_cppflags"-fi- if test "$fptools_cv_htype_sup_tcflag_t" = yes; then-  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $fptools_cv_htype_tcflag_t" >&5-$as_echo "$fptools_cv_htype_tcflag_t" >&6; }--cat >>confdefs.h <<_ACEOF-#define HTYPE_TCFLAG_T $fptools_cv_htype_tcflag_t-_ACEOF--else-  { $as_echo "$as_me:${as_lineno-$LINENO}: result: not supported" >&5-$as_echo "not supported" >&6; }-fi--{ $as_echo "$as_me:${as_lineno-$LINENO}: checking Haskell type for nlink_t" >&5-$as_echo_n "checking Haskell type for nlink_t... " >&6; }-if test "${fptools_cv_htype_nlink_t+set}" = set; then :-  $as_echo_n "(cached) " >&6-else-  fptools_cv_htype_sup_nlink_t=yes-fp_check_htype_save_cppflags="$CPPFLAGS"-CPPFLAGS="$CPPFLAGS $X_CFLAGS"-if test "$cross_compiling" = yes; then :-  fptools_cv_htype_nlink_t=NotReallyATypeCross; fptools_cv_htype_sup_nlink_t=no-else-  cat confdefs.h - <<_ACEOF >conftest.$ac_ext-/* end confdefs.h.  */-#include <stdio.h>-#include <stddef.h>--#if HAVE_SYS_TYPES_H-# include <sys/types.h>-#endif--#if HAVE_UNISTD_H-# include <unistd.h>-#endif--#if HAVE_SYS_STAT_H-# include <sys/stat.h>-#endif--#if HAVE_FCNTL_H-# include <fcntl.h>-#endif--#if HAVE_SIGNAL_H-# include <signal.h>-#endif--#if HAVE_TIME_H-# include <time.h>-#endif--#if HAVE_TERMIOS_H-# include <termios.h>-#endif--#if HAVE_STRING_H-# include <string.h>-#endif--#if HAVE_CTYPE_H-# include <ctype.h>-#endif--#if HAVE_INTTYPES_H-# include <inttypes.h>-#else-# if HAVE_STDINT_H-#  include <stdint.h>-# endif-#endif--#if defined(HAVE_GL_GL_H)-# include <GL/gl.h>-#elif defined(HAVE_OPENGL_GL_H)-# include <OpenGL/gl.h>-#endif--#if defined(HAVE_AL_AL_H)-# include <AL/al.h>-#elif defined(HAVE_OPENAL_AL_H)-# include <OpenAL/al.h>-#endif--#if defined(HAVE_AL_ALC_H)-# include <AL/alc.h>-#elif defined(HAVE_OPENAL_ALC_H)-# include <OpenAL/alc.h>-#endif--#if HAVE_SYS_RESOURCE_H-# include <sys/resource.h>-#endif--#include <stdlib.h>--typedef nlink_t testing;--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",-           (int)(sizeof(testing)*8));-  } else {-    fprintf(f,"%s\n",-           (sizeof(testing) >  sizeof(double)) ? "LDouble" :-           (sizeof(testing) == sizeof(double)) ? "Double"  : "Float");-  }-  fclose(f);-  exit(0);-}-_ACEOF-if ac_fn_c_try_run "$LINENO"; then :-  fptools_cv_htype_nlink_t=`cat conftestval`-else-  fptools_cv_htype_nlink_t=NotReallyAType; fptools_cv_htype_sup_nlink_t=no-fi-rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \-  conftest.$ac_objext conftest.beam conftest.$ac_ext-fi--CPPFLAGS="$fp_check_htype_save_cppflags"-fi- if test "$fptools_cv_htype_sup_nlink_t" = yes; then-  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $fptools_cv_htype_nlink_t" >&5-$as_echo "$fptools_cv_htype_nlink_t" >&6; }--cat >>confdefs.h <<_ACEOF-#define HTYPE_NLINK_T $fptools_cv_htype_nlink_t-_ACEOF--else-  { $as_echo "$as_me:${as_lineno-$LINENO}: result: not supported" >&5-$as_echo "not supported" >&6; }-fi--{ $as_echo "$as_me:${as_lineno-$LINENO}: checking Haskell type for ssize_t" >&5-$as_echo_n "checking Haskell type for ssize_t... " >&6; }-if test "${fptools_cv_htype_ssize_t+set}" = set; then :-  $as_echo_n "(cached) " >&6-else-  fptools_cv_htype_sup_ssize_t=yes-fp_check_htype_save_cppflags="$CPPFLAGS"-CPPFLAGS="$CPPFLAGS $X_CFLAGS"-if test "$cross_compiling" = yes; then :-  fptools_cv_htype_ssize_t=NotReallyATypeCross; fptools_cv_htype_sup_ssize_t=no-else-  cat confdefs.h - <<_ACEOF >conftest.$ac_ext-/* end confdefs.h.  */-#include <stdio.h>-#include <stddef.h>--#if HAVE_SYS_TYPES_H-# include <sys/types.h>-#endif--#if HAVE_UNISTD_H-# include <unistd.h>-#endif--#if HAVE_SYS_STAT_H-# include <sys/stat.h>-#endif--#if HAVE_FCNTL_H-# include <fcntl.h>-#endif--#if HAVE_SIGNAL_H-# include <signal.h>-#endif--#if HAVE_TIME_H-# include <time.h>-#endif--#if HAVE_TERMIOS_H-# include <termios.h>-#endif--#if HAVE_STRING_H-# include <string.h>-#endif--#if HAVE_CTYPE_H-# include <ctype.h>-#endif--#if HAVE_INTTYPES_H-# include <inttypes.h>-#else-# if HAVE_STDINT_H-#  include <stdint.h>-# endif-#endif--#if defined(HAVE_GL_GL_H)-# include <GL/gl.h>-#elif defined(HAVE_OPENGL_GL_H)-# include <OpenGL/gl.h>-#endif--#if defined(HAVE_AL_AL_H)-# include <AL/al.h>-#elif defined(HAVE_OPENAL_AL_H)-# include <OpenAL/al.h>-#endif--#if defined(HAVE_AL_ALC_H)-# include <AL/alc.h>-#elif defined(HAVE_OPENAL_ALC_H)-# include <OpenAL/alc.h>-#endif--#if HAVE_SYS_RESOURCE_H-# include <sys/resource.h>-#endif--#include <stdlib.h>--typedef ssize_t testing;--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",-           (int)(sizeof(testing)*8));-  } else {-    fprintf(f,"%s\n",-           (sizeof(testing) >  sizeof(double)) ? "LDouble" :-           (sizeof(testing) == sizeof(double)) ? "Double"  : "Float");-  }-  fclose(f);-  exit(0);-}-_ACEOF-if ac_fn_c_try_run "$LINENO"; then :-  fptools_cv_htype_ssize_t=`cat conftestval`-else-  fptools_cv_htype_ssize_t=NotReallyAType; fptools_cv_htype_sup_ssize_t=no-fi-rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \-  conftest.$ac_objext conftest.beam conftest.$ac_ext-fi--CPPFLAGS="$fp_check_htype_save_cppflags"-fi- if test "$fptools_cv_htype_sup_ssize_t" = yes; then-  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $fptools_cv_htype_ssize_t" >&5-$as_echo "$fptools_cv_htype_ssize_t" >&6; }--cat >>confdefs.h <<_ACEOF-#define HTYPE_SSIZE_T $fptools_cv_htype_ssize_t-_ACEOF--else-  { $as_echo "$as_me:${as_lineno-$LINENO}: result: not supported" >&5-$as_echo "not supported" >&6; }-fi--{ $as_echo "$as_me:${as_lineno-$LINENO}: checking Haskell type for rlim_t" >&5-$as_echo_n "checking Haskell type for rlim_t... " >&6; }-if test "${fptools_cv_htype_rlim_t+set}" = set; then :-  $as_echo_n "(cached) " >&6-else-  fptools_cv_htype_sup_rlim_t=yes-fp_check_htype_save_cppflags="$CPPFLAGS"-CPPFLAGS="$CPPFLAGS $X_CFLAGS"-if test "$cross_compiling" = yes; then :-  fptools_cv_htype_rlim_t=NotReallyATypeCross; fptools_cv_htype_sup_rlim_t=no-else-  cat confdefs.h - <<_ACEOF >conftest.$ac_ext-/* end confdefs.h.  */-#include <stdio.h>-#include <stddef.h>--#if HAVE_SYS_TYPES_H-# include <sys/types.h>-#endif--#if HAVE_UNISTD_H-# include <unistd.h>-#endif--#if HAVE_SYS_STAT_H-# include <sys/stat.h>-#endif--#if HAVE_FCNTL_H-# include <fcntl.h>-#endif--#if HAVE_SIGNAL_H-# include <signal.h>-#endif--#if HAVE_TIME_H-# include <time.h>-#endif--#if HAVE_TERMIOS_H-# include <termios.h>-#endif--#if HAVE_STRING_H-# include <string.h>-#endif--#if HAVE_CTYPE_H-# include <ctype.h>-#endif--#if HAVE_INTTYPES_H-# include <inttypes.h>-#else-# if HAVE_STDINT_H-#  include <stdint.h>-# endif-#endif--#if defined(HAVE_GL_GL_H)-# include <GL/gl.h>-#elif defined(HAVE_OPENGL_GL_H)-# include <OpenGL/gl.h>-#endif--#if defined(HAVE_AL_AL_H)-# include <AL/al.h>-#elif defined(HAVE_OPENAL_AL_H)-# include <OpenAL/al.h>-#endif--#if defined(HAVE_AL_ALC_H)-# include <AL/alc.h>-#elif defined(HAVE_OPENAL_ALC_H)-# include <OpenAL/alc.h>-#endif--#if HAVE_SYS_RESOURCE_H-# include <sys/resource.h>-#endif--#include <stdlib.h>--typedef rlim_t testing;--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",-           (int)(sizeof(testing)*8));-  } else {-    fprintf(f,"%s\n",-           (sizeof(testing) >  sizeof(double)) ? "LDouble" :-           (sizeof(testing) == sizeof(double)) ? "Double"  : "Float");-  }-  fclose(f);-  exit(0);-}-_ACEOF-if ac_fn_c_try_run "$LINENO"; then :-  fptools_cv_htype_rlim_t=`cat conftestval`-else-  fptools_cv_htype_rlim_t=NotReallyAType; fptools_cv_htype_sup_rlim_t=no-fi-rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \-  conftest.$ac_objext conftest.beam conftest.$ac_ext-fi--CPPFLAGS="$fp_check_htype_save_cppflags"-fi- if test "$fptools_cv_htype_sup_rlim_t" = yes; then-  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $fptools_cv_htype_rlim_t" >&5-$as_echo "$fptools_cv_htype_rlim_t" >&6; }--cat >>confdefs.h <<_ACEOF-#define HTYPE_RLIM_T $fptools_cv_htype_rlim_t-_ACEOF--else-  { $as_echo "$as_me:${as_lineno-$LINENO}: result: not supported" >&5-$as_echo "not supported" >&6; }-fi--{ $as_echo "$as_me:${as_lineno-$LINENO}: checking Haskell type for wint_t" >&5-$as_echo_n "checking Haskell type for wint_t... " >&6; }-if test "${fptools_cv_htype_wint_t+set}" = set; then :-  $as_echo_n "(cached) " >&6-else-  fptools_cv_htype_sup_wint_t=yes-fp_check_htype_save_cppflags="$CPPFLAGS"-CPPFLAGS="$CPPFLAGS $X_CFLAGS"-if test "$cross_compiling" = yes; then :-  fptools_cv_htype_wint_t=NotReallyATypeCross; fptools_cv_htype_sup_wint_t=no-else-  cat confdefs.h - <<_ACEOF >conftest.$ac_ext-/* end confdefs.h.  */-#include <stdio.h>-#include <stddef.h>--#if HAVE_SYS_TYPES_H-# include <sys/types.h>-#endif--#if HAVE_UNISTD_H-# include <unistd.h>-#endif--#if HAVE_SYS_STAT_H-# include <sys/stat.h>-#endif--#if HAVE_FCNTL_H-# include <fcntl.h>-#endif--#if HAVE_SIGNAL_H-# include <signal.h>-#endif--#if HAVE_TIME_H-# include <time.h>-#endif--#if HAVE_TERMIOS_H-# include <termios.h>-#endif--#if HAVE_STRING_H-# include <string.h>-#endif--#if HAVE_CTYPE_H-# include <ctype.h>-#endif--#if HAVE_INTTYPES_H-# include <inttypes.h>-#else-# if HAVE_STDINT_H-#  include <stdint.h>-# endif-#endif--#if defined(HAVE_GL_GL_H)-# include <GL/gl.h>-#elif defined(HAVE_OPENGL_GL_H)-# include <OpenGL/gl.h>-#endif--#if defined(HAVE_AL_AL_H)-# include <AL/al.h>-#elif defined(HAVE_OPENAL_AL_H)-# include <OpenAL/al.h>-#endif--#if defined(HAVE_AL_ALC_H)-# include <AL/alc.h>-#elif defined(HAVE_OPENAL_ALC_H)-# include <OpenAL/alc.h>-#endif--#if HAVE_SYS_RESOURCE_H-# include <sys/resource.h>-#endif--#include <stdlib.h>--typedef wint_t testing;--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",-           (int)(sizeof(testing)*8));-  } else {-    fprintf(f,"%s\n",-           (sizeof(testing) >  sizeof(double)) ? "LDouble" :-           (sizeof(testing) == sizeof(double)) ? "Double"  : "Float");-  }-  fclose(f);-  exit(0);-}-_ACEOF-if ac_fn_c_try_run "$LINENO"; then :-  fptools_cv_htype_wint_t=`cat conftestval`-else-  fptools_cv_htype_wint_t=NotReallyAType; fptools_cv_htype_sup_wint_t=no-fi-rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \-  conftest.$ac_objext conftest.beam conftest.$ac_ext-fi--CPPFLAGS="$fp_check_htype_save_cppflags"-fi- if test "$fptools_cv_htype_sup_wint_t" = yes; then-  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $fptools_cv_htype_wint_t" >&5-$as_echo "$fptools_cv_htype_wint_t" >&6; }--cat >>confdefs.h <<_ACEOF-#define HTYPE_WINT_T $fptools_cv_htype_wint_t-_ACEOF--else-  { $as_echo "$as_me:${as_lineno-$LINENO}: result: not supported" >&5-$as_echo "not supported" >&6; }-fi---{ $as_echo "$as_me:${as_lineno-$LINENO}: checking Haskell type for intptr_t" >&5-$as_echo_n "checking Haskell type for intptr_t... " >&6; }-if test "${fptools_cv_htype_intptr_t+set}" = set; then :-  $as_echo_n "(cached) " >&6-else-  fptools_cv_htype_sup_intptr_t=yes-fp_check_htype_save_cppflags="$CPPFLAGS"-CPPFLAGS="$CPPFLAGS $X_CFLAGS"-if test "$cross_compiling" = yes; then :-  fptools_cv_htype_intptr_t=NotReallyATypeCross; fptools_cv_htype_sup_intptr_t=no-else-  cat confdefs.h - <<_ACEOF >conftest.$ac_ext-/* end confdefs.h.  */-#include <stdio.h>-#include <stddef.h>--#if HAVE_SYS_TYPES_H-# include <sys/types.h>-#endif--#if HAVE_UNISTD_H-# include <unistd.h>-#endif--#if HAVE_SYS_STAT_H-# include <sys/stat.h>-#endif--#if HAVE_FCNTL_H-# include <fcntl.h>-#endif--#if HAVE_SIGNAL_H-# include <signal.h>-#endif--#if HAVE_TIME_H-# include <time.h>-#endif--#if HAVE_TERMIOS_H-# include <termios.h>-#endif--#if HAVE_STRING_H-# include <string.h>-#endif--#if HAVE_CTYPE_H-# include <ctype.h>-#endif--#if HAVE_INTTYPES_H-# include <inttypes.h>-#else-# if HAVE_STDINT_H-#  include <stdint.h>-# endif-#endif--#if defined(HAVE_GL_GL_H)-# include <GL/gl.h>-#elif defined(HAVE_OPENGL_GL_H)-# include <OpenGL/gl.h>-#endif--#if defined(HAVE_AL_AL_H)-# include <AL/al.h>-#elif defined(HAVE_OPENAL_AL_H)-# include <OpenAL/al.h>-#endif--#if defined(HAVE_AL_ALC_H)-# include <AL/alc.h>-#elif defined(HAVE_OPENAL_ALC_H)-# include <OpenAL/alc.h>-#endif--#if HAVE_SYS_RESOURCE_H-# include <sys/resource.h>-#endif--#include <stdlib.h>--typedef intptr_t testing;--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",-           (int)(sizeof(testing)*8));-  } else {-    fprintf(f,"%s\n",-           (sizeof(testing) >  sizeof(double)) ? "LDouble" :-           (sizeof(testing) == sizeof(double)) ? "Double"  : "Float");-  }-  fclose(f);-  exit(0);-}-_ACEOF-if ac_fn_c_try_run "$LINENO"; then :-  fptools_cv_htype_intptr_t=`cat conftestval`-else-  fptools_cv_htype_intptr_t=NotReallyAType; fptools_cv_htype_sup_intptr_t=no-fi-rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \-  conftest.$ac_objext conftest.beam conftest.$ac_ext-fi--CPPFLAGS="$fp_check_htype_save_cppflags"-fi- if test "$fptools_cv_htype_sup_intptr_t" = yes; then-  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $fptools_cv_htype_intptr_t" >&5-$as_echo "$fptools_cv_htype_intptr_t" >&6; }--cat >>confdefs.h <<_ACEOF-#define HTYPE_INTPTR_T $fptools_cv_htype_intptr_t-_ACEOF--else-  { $as_echo "$as_me:${as_lineno-$LINENO}: result: not supported" >&5-$as_echo "not supported" >&6; }-fi--{ $as_echo "$as_me:${as_lineno-$LINENO}: checking Haskell type for uintptr_t" >&5-$as_echo_n "checking Haskell type for uintptr_t... " >&6; }-if test "${fptools_cv_htype_uintptr_t+set}" = set; then :-  $as_echo_n "(cached) " >&6-else-  fptools_cv_htype_sup_uintptr_t=yes-fp_check_htype_save_cppflags="$CPPFLAGS"-CPPFLAGS="$CPPFLAGS $X_CFLAGS"-if test "$cross_compiling" = yes; then :-  fptools_cv_htype_uintptr_t=NotReallyATypeCross; fptools_cv_htype_sup_uintptr_t=no-else-  cat confdefs.h - <<_ACEOF >conftest.$ac_ext-/* end confdefs.h.  */-#include <stdio.h>-#include <stddef.h>--#if HAVE_SYS_TYPES_H-# include <sys/types.h>-#endif--#if HAVE_UNISTD_H-# include <unistd.h>-#endif--#if HAVE_SYS_STAT_H-# include <sys/stat.h>-#endif--#if HAVE_FCNTL_H-# include <fcntl.h>-#endif--#if HAVE_SIGNAL_H-# include <signal.h>-#endif--#if HAVE_TIME_H-# include <time.h>-#endif--#if HAVE_TERMIOS_H-# include <termios.h>-#endif--#if HAVE_STRING_H-# include <string.h>-#endif--#if HAVE_CTYPE_H-# include <ctype.h>-#endif--#if HAVE_INTTYPES_H-# include <inttypes.h>-#else-# if HAVE_STDINT_H-#  include <stdint.h>-# endif-#endif--#if defined(HAVE_GL_GL_H)-# include <GL/gl.h>-#elif defined(HAVE_OPENGL_GL_H)-# include <OpenGL/gl.h>-#endif--#if defined(HAVE_AL_AL_H)-# include <AL/al.h>-#elif defined(HAVE_OPENAL_AL_H)-# include <OpenAL/al.h>-#endif--#if defined(HAVE_AL_ALC_H)-# include <AL/alc.h>-#elif defined(HAVE_OPENAL_ALC_H)-# include <OpenAL/alc.h>-#endif--#if HAVE_SYS_RESOURCE_H-# include <sys/resource.h>-#endif--#include <stdlib.h>--typedef uintptr_t testing;--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",-           (int)(sizeof(testing)*8));-  } else {-    fprintf(f,"%s\n",-           (sizeof(testing) >  sizeof(double)) ? "LDouble" :-           (sizeof(testing) == sizeof(double)) ? "Double"  : "Float");-  }-  fclose(f);-  exit(0);-}-_ACEOF-if ac_fn_c_try_run "$LINENO"; then :-  fptools_cv_htype_uintptr_t=`cat conftestval`-else-  fptools_cv_htype_uintptr_t=NotReallyAType; fptools_cv_htype_sup_uintptr_t=no-fi-rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \-  conftest.$ac_objext conftest.beam conftest.$ac_ext-fi--CPPFLAGS="$fp_check_htype_save_cppflags"-fi- if test "$fptools_cv_htype_sup_uintptr_t" = yes; then-  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $fptools_cv_htype_uintptr_t" >&5-$as_echo "$fptools_cv_htype_uintptr_t" >&6; }--cat >>confdefs.h <<_ACEOF-#define HTYPE_UINTPTR_T $fptools_cv_htype_uintptr_t-_ACEOF--else-  { $as_echo "$as_me:${as_lineno-$LINENO}: result: not supported" >&5-$as_echo "not supported" >&6; }-fi--# Workaround for OSes that don't have intmax_t and uintmax_t, e.g. OpenBSD.-if test "$ac_cv_type_long_long" = yes; then-  fptools_cv_default_htype_intmax=$fptools_cv_htype_long_long-  fptools_cv_default_htype_uintmax=$fptools_cv_htype_unsigned_long_long-else-  fptools_cv_default_htype_intmax=$fptools_cv_htype_long-  fptools_cv_default_htype_uintmax=$fptools_cv_htype_unsigned_long-fi-{ $as_echo "$as_me:${as_lineno-$LINENO}: checking Haskell type for intmax_t" >&5-$as_echo_n "checking Haskell type for intmax_t... " >&6; }-if test "${fptools_cv_htype_intmax_t+set}" = set; then :-  $as_echo_n "(cached) " >&6-else-  fptools_cv_htype_sup_intmax_t=yes-fp_check_htype_save_cppflags="$CPPFLAGS"-CPPFLAGS="$CPPFLAGS $X_CFLAGS"-if test "$cross_compiling" = yes; then :-  fptools_cv_htype_intmax_t=NotReallyATypeCross; fptools_cv_htype_sup_intmax_t=no-else-  cat confdefs.h - <<_ACEOF >conftest.$ac_ext-/* end confdefs.h.  */-#include <stdio.h>-#include <stddef.h>--#if HAVE_SYS_TYPES_H-# include <sys/types.h>-#endif--#if HAVE_UNISTD_H-# include <unistd.h>-#endif--#if HAVE_SYS_STAT_H-# include <sys/stat.h>-#endif--#if HAVE_FCNTL_H-# include <fcntl.h>-#endif--#if HAVE_SIGNAL_H-# include <signal.h>-#endif--#if HAVE_TIME_H-# include <time.h>-#endif--#if HAVE_TERMIOS_H-# include <termios.h>-#endif--#if HAVE_STRING_H-# include <string.h>-#endif--#if HAVE_CTYPE_H-# include <ctype.h>-#endif--#if HAVE_INTTYPES_H-# include <inttypes.h>-#else-# if HAVE_STDINT_H-#  include <stdint.h>-# endif-#endif--#if defined(HAVE_GL_GL_H)-# include <GL/gl.h>-#elif defined(HAVE_OPENGL_GL_H)-# include <OpenGL/gl.h>-#endif--#if defined(HAVE_AL_AL_H)-# include <AL/al.h>-#elif defined(HAVE_OPENAL_AL_H)-# include <OpenAL/al.h>-#endif--#if defined(HAVE_AL_ALC_H)-# include <AL/alc.h>-#elif defined(HAVE_OPENAL_ALC_H)-# include <OpenAL/alc.h>-#endif--#if HAVE_SYS_RESOURCE_H-# include <sys/resource.h>-#endif--#include <stdlib.h>--typedef intmax_t testing;--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",-           (int)(sizeof(testing)*8));-  } else {-    fprintf(f,"%s\n",-           (sizeof(testing) >  sizeof(double)) ? "LDouble" :-           (sizeof(testing) == sizeof(double)) ? "Double"  : "Float");-  }-  fclose(f);-  exit(0);-}-_ACEOF-if ac_fn_c_try_run "$LINENO"; then :-  fptools_cv_htype_intmax_t=`cat conftestval`-else-  fptools_cv_htype_intmax_t=$fptools_cv_default_htype_intmax-fi-rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \-  conftest.$ac_objext conftest.beam conftest.$ac_ext-fi--CPPFLAGS="$fp_check_htype_save_cppflags"-fi- if test "$fptools_cv_htype_sup_intmax_t" = yes; then-  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $fptools_cv_htype_intmax_t" >&5-$as_echo "$fptools_cv_htype_intmax_t" >&6; }--cat >>confdefs.h <<_ACEOF-#define HTYPE_INTMAX_T $fptools_cv_htype_intmax_t-_ACEOF--else-  { $as_echo "$as_me:${as_lineno-$LINENO}: result: not supported" >&5-$as_echo "not supported" >&6; }-fi--{ $as_echo "$as_me:${as_lineno-$LINENO}: checking Haskell type for uintmax_t" >&5-$as_echo_n "checking Haskell type for uintmax_t... " >&6; }-if test "${fptools_cv_htype_uintmax_t+set}" = set; then :-  $as_echo_n "(cached) " >&6-else-  fptools_cv_htype_sup_uintmax_t=yes-fp_check_htype_save_cppflags="$CPPFLAGS"-CPPFLAGS="$CPPFLAGS $X_CFLAGS"-if test "$cross_compiling" = yes; then :-  fptools_cv_htype_uintmax_t=NotReallyATypeCross; fptools_cv_htype_sup_uintmax_t=no-else-  cat confdefs.h - <<_ACEOF >conftest.$ac_ext-/* end confdefs.h.  */-#include <stdio.h>-#include <stddef.h>--#if HAVE_SYS_TYPES_H-# include <sys/types.h>-#endif--#if HAVE_UNISTD_H-# include <unistd.h>-#endif--#if HAVE_SYS_STAT_H-# include <sys/stat.h>-#endif--#if HAVE_FCNTL_H-# include <fcntl.h>-#endif--#if HAVE_SIGNAL_H-# include <signal.h>-#endif--#if HAVE_TIME_H-# include <time.h>-#endif--#if HAVE_TERMIOS_H-# include <termios.h>-#endif--#if HAVE_STRING_H-# include <string.h>-#endif--#if HAVE_CTYPE_H-# include <ctype.h>-#endif--#if HAVE_INTTYPES_H-# include <inttypes.h>-#else-# if HAVE_STDINT_H-#  include <stdint.h>-# endif-#endif--#if defined(HAVE_GL_GL_H)-# include <GL/gl.h>-#elif defined(HAVE_OPENGL_GL_H)-# include <OpenGL/gl.h>-#endif--#if defined(HAVE_AL_AL_H)-# include <AL/al.h>-#elif defined(HAVE_OPENAL_AL_H)-# include <OpenAL/al.h>-#endif--#if defined(HAVE_AL_ALC_H)-# include <AL/alc.h>-#elif defined(HAVE_OPENAL_ALC_H)-# include <OpenAL/alc.h>-#endif--#if HAVE_SYS_RESOURCE_H-# include <sys/resource.h>-#endif--#include <stdlib.h>--typedef uintmax_t testing;--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",-           (int)(sizeof(testing)*8));-  } else {-    fprintf(f,"%s\n",-           (sizeof(testing) >  sizeof(double)) ? "LDouble" :-           (sizeof(testing) == sizeof(double)) ? "Double"  : "Float");-  }-  fclose(f);-  exit(0);-}-_ACEOF-if ac_fn_c_try_run "$LINENO"; then :-  fptools_cv_htype_uintmax_t=`cat conftestval`-else-  fptools_cv_htype_uintmax_t=$fptools_cv_default_htype_uintmax-fi-rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \-  conftest.$ac_objext conftest.beam conftest.$ac_ext-fi--CPPFLAGS="$fp_check_htype_save_cppflags"-fi- if test "$fptools_cv_htype_sup_uintmax_t" = yes; then-  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $fptools_cv_htype_uintmax_t" >&5-$as_echo "$fptools_cv_htype_uintmax_t" >&6; }--cat >>confdefs.h <<_ACEOF-#define HTYPE_UINTMAX_T $fptools_cv_htype_uintmax_t-_ACEOF--else-  { $as_echo "$as_me:${as_lineno-$LINENO}: result: not supported" >&5-$as_echo "not supported" >&6; }-fi---# test errno values-for fp_const_name in E2BIG EACCES EADDRINUSE EADDRNOTAVAIL EADV EAFNOSUPPORT EAGAIN EALREADY EBADF EBADMSG EBADRPC EBUSY ECHILD ECOMM ECONNABORTED ECONNREFUSED ECONNRESET EDEADLK EDESTADDRREQ EDIRTY EDOM EDQUOT EEXIST EFAULT EFBIG EFTYPE EHOSTDOWN EHOSTUNREACH EIDRM EILSEQ EINPROGRESS EINTR EINVAL EIO EISCONN EISDIR ELOOP EMFILE EMLINK EMSGSIZE EMULTIHOP ENAMETOOLONG ENETDOWN ENETRESET ENETUNREACH ENFILE ENOBUFS ENODATA ENODEV ENOENT ENOEXEC ENOLCK ENOLINK ENOMEM ENOMSG ENONET ENOPROTOOPT ENOSPC ENOSR ENOSTR ENOSYS ENOTBLK ENOTCONN ENOTDIR ENOTEMPTY ENOTSOCK ENOTTY ENXIO EOPNOTSUPP EPERM EPFNOSUPPORT EPIPE EPROCLIM EPROCUNAVAIL EPROGMISMATCH EPROGUNAVAIL EPROTO EPROTONOSUPPORT EPROTOTYPE ERANGE EREMCHG EREMOTE EROFS ERPCMISMATCH ERREMOTE ESHUTDOWN ESOCKTNOSUPPORT ESPIPE ESRCH ESRMNT ESTALE ETIME ETIMEDOUT ETOOMANYREFS ETXTBSY EUSERS EWOULDBLOCK EXDEV ENOCIGAR-do-as_fp_Cache=`$as_echo "fp_cv_const_$fp_const_name" | $as_tr_sh`-{ $as_echo "$as_me:${as_lineno-$LINENO}: checking value of $fp_const_name" >&5-$as_echo_n "checking value of $fp_const_name... " >&6; }-if eval "test \"\${$as_fp_Cache+set}\"" = set; then :-  $as_echo_n "(cached) " >&6-else-  if ac_fn_c_compute_int "$LINENO" "$fp_const_name" "fp_check_const_result"        "#include <stdio.h>-#include <errno.h>-"; then :--else-  fp_check_const_result='-1'-fi---eval "$as_fp_Cache=\$fp_check_const_result"-fi-eval ac_res=\$$as_fp_Cache-	       { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5-$as_echo "$ac_res" >&6; }-cat >>confdefs.h <<_ACEOF-#define `$as_echo "CONST_$fp_const_name" | $as_tr_cpp` `eval 'as_val=${'$as_fp_Cache'};$as_echo "$as_val"'`-_ACEOF--done---# we need SIGINT in TopHandler.lhs-for fp_const_name in SIGINT-do-as_fp_Cache=`$as_echo "fp_cv_const_$fp_const_name" | $as_tr_sh`-{ $as_echo "$as_me:${as_lineno-$LINENO}: checking value of $fp_const_name" >&5-$as_echo_n "checking value of $fp_const_name... " >&6; }-if eval "test \"\${$as_fp_Cache+set}\"" = set; then :-  $as_echo_n "(cached) " >&6-else-  if ac_fn_c_compute_int "$LINENO" "$fp_const_name" "fp_check_const_result"        "-#if HAVE_SIGNAL_H-#include <signal.h>-#endif-"; then :--else-  fp_check_const_result='-1'-fi---eval "$as_fp_Cache=\$fp_check_const_result"-fi-eval ac_res=\$$as_fp_Cache-	       { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5-$as_echo "$ac_res" >&6; }-cat >>confdefs.h <<_ACEOF-#define `$as_echo "CONST_$fp_const_name" | $as_tr_cpp` `eval 'as_val=${'$as_fp_Cache'};$as_echo "$as_val"'`-_ACEOF--done---{ $as_echo "$as_me:${as_lineno-$LINENO}: checking value of O_BINARY" >&5-$as_echo_n "checking value of O_BINARY... " >&6; }-if test "${fp_cv_const_O_BINARY+set}" = set; then :-  $as_echo_n "(cached) " >&6-else-  if ac_fn_c_compute_int "$LINENO" "O_BINARY" "fp_check_const_result"        "#include <fcntl.h>-"; then :--else-  fp_check_const_result=0-fi---fp_cv_const_O_BINARY=$fp_check_const_result-fi-{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $fp_cv_const_O_BINARY" >&5-$as_echo "$fp_cv_const_O_BINARY" >&6; }-cat >>confdefs.h <<_ACEOF-#define CONST_O_BINARY $fp_cv_const_O_BINARY-_ACEOF---# 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.-{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for library containing iconv" >&5-$as_echo_n "checking for library containing iconv... " >&6; }-if test "${ac_cv_search_iconv+set}" = set; then :-  $as_echo_n "(cached) " >&6-else-  ac_func_search_save_LIBS=$LIBS-cat confdefs.h - <<_ACEOF >conftest.$ac_ext-/* end confdefs.h.  */--#include <stddef.h>-#include <iconv.h>--int-main ()-{-iconv_t cd;-                      cd = iconv_open("", "");-                      iconv(cd,NULL,NULL,NULL,NULL);-                      iconv_close(cd);-  ;-  return 0;-}-_ACEOF-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-  if ac_fn_c_try_link "$LINENO"; then :-  ac_cv_search_iconv=$ac_res-fi-rm -f core conftest.err conftest.$ac_objext \-    conftest$ac_exeext-  if test "${ac_cv_search_iconv+set}" = set; then :-  break-fi-done-if test "${ac_cv_search_iconv+set}" = set; then :--else-  ac_cv_search_iconv=no-fi-rm conftest.$ac_ext-LIBS=$ac_func_search_save_LIBS-fi-{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_search_iconv" >&5-$as_echo "$ac_cv_search_iconv" >&6; }-ac_res=$ac_cv_search_iconv-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*) ;;-                        *)-                             as_fn_error $? "iconv is required on non-Windows platforms" "$LINENO" 5 ;;-                      esac-fi--# If possible, we use libcharset instead of nl_langinfo(CODESET) to-# determine the current locale's character encoding.-{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for library containing locale_charset" >&5-$as_echo_n "checking for library containing locale_charset... " >&6; }-if test "${ac_cv_search_locale_charset+set}" = set; then :-  $as_echo_n "(cached) " >&6-else-  ac_func_search_save_LIBS=$LIBS-cat confdefs.h - <<_ACEOF >conftest.$ac_ext-/* end confdefs.h.  */-#include <libcharset.h>-int-main ()-{-const char* charset = locale_charset();-  ;-  return 0;-}-_ACEOF-for ac_lib in '' charset; 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-  if ac_fn_c_try_link "$LINENO"; then :-  ac_cv_search_locale_charset=$ac_res-fi-rm -f core conftest.err conftest.$ac_objext \-    conftest$ac_exeext-  if test "${ac_cv_search_locale_charset+set}" = set; then :-  break-fi-done-if test "${ac_cv_search_locale_charset+set}" = set; then :--else-  ac_cv_search_locale_charset=no-fi-rm conftest.$ac_ext-LIBS=$ac_func_search_save_LIBS-fi-{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_search_locale_charset" >&5-$as_echo "$ac_cv_search_locale_charset" >&6; }-ac_res=$ac_cv_search_locale_charset-if test "$ac_res" != no; then :-  test "$ac_res" = "none required" || LIBS="$ac_res $LIBS"--$as_echo "#define HAVE_LIBCHARSET 1" >>confdefs.h--     EXTRA_LIBS="$EXTRA_LIBS $ac_lib"-fi+case `uname -s` in+    MINGW*|CYGWIN*)+        WINDOWS=YES;;+    *)+        WINDOWS=NO;;+esac++# do we have long longs?++ac_ext=c+ac_cpp='$CPP $CPPFLAGS'+ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5'+ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5'+ac_compiler_gnu=$ac_cv_c_compiler_gnu+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking how to run the C preprocessor" >&5+$as_echo_n "checking how to run the C preprocessor... " >&6; }+# On Suns, sometimes $CPP names a directory.+if test -n "$CPP" && test -d "$CPP"; then+  CPP=+fi+if test -z "$CPP"; then+  if test "${ac_cv_prog_CPP+set}" = set; then :+  $as_echo_n "(cached) " >&6+else+      # Double quotes because CPP needs to be expanded+    for CPP in "$CC -E" "$CC -E -traditional-cpp" "/lib/cpp"+    do+      ac_preproc_ok=false+for ac_c_preproc_warn_flag in '' yes+do+  # Use a header file that comes with gcc, so configuring glibc+  # with a fresh cross-compiler works.+  # Prefer <limits.h> to <assert.h> if __STDC__ is defined, since+  # <limits.h> exists even on freestanding compilers.+  # On the NeXT, cc -E runs the code through the compiler's parser,+  # not just through cpp. "Syntax error" is here to catch this case.+  cat confdefs.h - <<_ACEOF >conftest.$ac_ext+/* end confdefs.h.  */+#ifdef __STDC__+# include <limits.h>+#else+# include <assert.h>+#endif+		     Syntax error+_ACEOF+if ac_fn_c_try_cpp "$LINENO"; then :++else+  # Broken: fails on valid input.+continue+fi+rm -f conftest.err conftest.i conftest.$ac_ext++  # OK, works on sane cases.  Now check whether nonexistent headers+  # can be detected and how.+  cat confdefs.h - <<_ACEOF >conftest.$ac_ext+/* end confdefs.h.  */+#include <ac_nonexistent.h>+_ACEOF+if ac_fn_c_try_cpp "$LINENO"; then :+  # Broken: success on invalid input.+continue+else+  # Passes both tests.+ac_preproc_ok=:+break+fi+rm -f conftest.err conftest.i conftest.$ac_ext++done+# Because of `break', _AC_PREPROC_IFELSE's cleaning code was skipped.+rm -f conftest.i conftest.err conftest.$ac_ext+if $ac_preproc_ok; then :+  break+fi++    done+    ac_cv_prog_CPP=$CPP++fi+  CPP=$ac_cv_prog_CPP+else+  ac_cv_prog_CPP=$CPP+fi+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $CPP" >&5+$as_echo "$CPP" >&6; }+ac_preproc_ok=false+for ac_c_preproc_warn_flag in '' yes+do+  # Use a header file that comes with gcc, so configuring glibc+  # with a fresh cross-compiler works.+  # Prefer <limits.h> to <assert.h> if __STDC__ is defined, since+  # <limits.h> exists even on freestanding compilers.+  # On the NeXT, cc -E runs the code through the compiler's parser,+  # not just through cpp. "Syntax error" is here to catch this case.+  cat confdefs.h - <<_ACEOF >conftest.$ac_ext+/* end confdefs.h.  */+#ifdef __STDC__+# include <limits.h>+#else+# include <assert.h>+#endif+		     Syntax error+_ACEOF+if ac_fn_c_try_cpp "$LINENO"; then :++else+  # Broken: fails on valid input.+continue+fi+rm -f conftest.err conftest.i conftest.$ac_ext++  # OK, works on sane cases.  Now check whether nonexistent headers+  # can be detected and how.+  cat confdefs.h - <<_ACEOF >conftest.$ac_ext+/* end confdefs.h.  */+#include <ac_nonexistent.h>+_ACEOF+if ac_fn_c_try_cpp "$LINENO"; then :+  # Broken: success on invalid input.+continue+else+  # Passes both tests.+ac_preproc_ok=:+break+fi+rm -f conftest.err conftest.i conftest.$ac_ext++done+# Because of `break', _AC_PREPROC_IFELSE's cleaning code was skipped.+rm -f conftest.i conftest.err conftest.$ac_ext+if $ac_preproc_ok; then :++else+  { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5+$as_echo "$as_me: error: in \`$ac_pwd':" >&2;}+as_fn_error $? "C preprocessor \"$CPP\" fails sanity check+See \`config.log' for more details" "$LINENO" 5 ; }+fi++ac_ext=c+ac_cpp='$CPP $CPPFLAGS'+ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5'+ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5'+ac_compiler_gnu=$ac_cv_c_compiler_gnu+++{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for grep that handles long lines and -e" >&5+$as_echo_n "checking for grep that handles long lines and -e... " >&6; }+if test "${ac_cv_path_GREP+set}" = set; then :+  $as_echo_n "(cached) " >&6+else+  if test -z "$GREP"; then+  ac_path_GREP_found=false+  # Loop through the user's path and test for each of PROGNAME-LIST+  as_save_IFS=$IFS; IFS=$PATH_SEPARATOR+for as_dir in $PATH$PATH_SEPARATOR/usr/xpg4/bin+do+  IFS=$as_save_IFS+  test -z "$as_dir" && as_dir=.+    for ac_prog in grep ggrep; do+    for ac_exec_ext in '' $ac_executable_extensions; do+      ac_path_GREP="$as_dir/$ac_prog$ac_exec_ext"+      { test -f "$ac_path_GREP" && $as_test_x "$ac_path_GREP"; } || continue+# Check for GNU ac_path_GREP and select it if it is found.+  # Check for GNU $ac_path_GREP+case `"$ac_path_GREP" --version 2>&1` in+*GNU*)+  ac_cv_path_GREP="$ac_path_GREP" ac_path_GREP_found=:;;+*)+  ac_count=0+  $as_echo_n 0123456789 >"conftest.in"+  while :+  do+    cat "conftest.in" "conftest.in" >"conftest.tmp"+    mv "conftest.tmp" "conftest.in"+    cp "conftest.in" "conftest.nl"+    $as_echo 'GREP' >> "conftest.nl"+    "$ac_path_GREP" -e 'GREP$' -e '-(cannot match)-' < "conftest.nl" >"conftest.out" 2>/dev/null || break+    diff "conftest.out" "conftest.nl" >/dev/null 2>&1 || break+    as_fn_arith $ac_count + 1 && ac_count=$as_val+    if test $ac_count -gt ${ac_path_GREP_max-0}; then+      # Best one so far, save it but keep looking for a better one+      ac_cv_path_GREP="$ac_path_GREP"+      ac_path_GREP_max=$ac_count+    fi+    # 10*(2^10) chars as input seems more than enough+    test $ac_count -gt 10 && break+  done+  rm -f conftest.in conftest.tmp conftest.nl conftest.out;;+esac++      $ac_path_GREP_found && break 3+    done+  done+  done+IFS=$as_save_IFS+  if test -z "$ac_cv_path_GREP"; then+    as_fn_error $? "no acceptable grep could be found in $PATH$PATH_SEPARATOR/usr/xpg4/bin" "$LINENO" 5+  fi+else+  ac_cv_path_GREP=$GREP+fi++fi+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_path_GREP" >&5+$as_echo "$ac_cv_path_GREP" >&6; }+ GREP="$ac_cv_path_GREP"+++{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for egrep" >&5+$as_echo_n "checking for egrep... " >&6; }+if test "${ac_cv_path_EGREP+set}" = set; then :+  $as_echo_n "(cached) " >&6+else+  if echo a | $GREP -E '(a|b)' >/dev/null 2>&1+   then ac_cv_path_EGREP="$GREP -E"+   else+     if test -z "$EGREP"; then+  ac_path_EGREP_found=false+  # Loop through the user's path and test for each of PROGNAME-LIST+  as_save_IFS=$IFS; IFS=$PATH_SEPARATOR+for as_dir in $PATH$PATH_SEPARATOR/usr/xpg4/bin+do+  IFS=$as_save_IFS+  test -z "$as_dir" && as_dir=.+    for ac_prog in egrep; do+    for ac_exec_ext in '' $ac_executable_extensions; do+      ac_path_EGREP="$as_dir/$ac_prog$ac_exec_ext"+      { test -f "$ac_path_EGREP" && $as_test_x "$ac_path_EGREP"; } || continue+# Check for GNU ac_path_EGREP and select it if it is found.+  # Check for GNU $ac_path_EGREP+case `"$ac_path_EGREP" --version 2>&1` in+*GNU*)+  ac_cv_path_EGREP="$ac_path_EGREP" ac_path_EGREP_found=:;;+*)+  ac_count=0+  $as_echo_n 0123456789 >"conftest.in"+  while :+  do+    cat "conftest.in" "conftest.in" >"conftest.tmp"+    mv "conftest.tmp" "conftest.in"+    cp "conftest.in" "conftest.nl"+    $as_echo 'EGREP' >> "conftest.nl"+    "$ac_path_EGREP" 'EGREP$' < "conftest.nl" >"conftest.out" 2>/dev/null || break+    diff "conftest.out" "conftest.nl" >/dev/null 2>&1 || break+    as_fn_arith $ac_count + 1 && ac_count=$as_val+    if test $ac_count -gt ${ac_path_EGREP_max-0}; then+      # Best one so far, save it but keep looking for a better one+      ac_cv_path_EGREP="$ac_path_EGREP"+      ac_path_EGREP_max=$ac_count+    fi+    # 10*(2^10) chars as input seems more than enough+    test $ac_count -gt 10 && break+  done+  rm -f conftest.in conftest.tmp conftest.nl conftest.out;;+esac++      $ac_path_EGREP_found && break 3+    done+  done+  done+IFS=$as_save_IFS+  if test -z "$ac_cv_path_EGREP"; then+    as_fn_error $? "no acceptable egrep could be found in $PATH$PATH_SEPARATOR/usr/xpg4/bin" "$LINENO" 5+  fi+else+  ac_cv_path_EGREP=$EGREP+fi++   fi+fi+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_path_EGREP" >&5+$as_echo "$ac_cv_path_EGREP" >&6; }+ EGREP="$ac_cv_path_EGREP"+++{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for ANSI C header files" >&5+$as_echo_n "checking for ANSI C header files... " >&6; }+if test "${ac_cv_header_stdc+set}" = set; then :+  $as_echo_n "(cached) " >&6+else+  cat confdefs.h - <<_ACEOF >conftest.$ac_ext+/* end confdefs.h.  */+#include <stdlib.h>+#include <stdarg.h>+#include <string.h>+#include <float.h>++int+main ()+{++  ;+  return 0;+}+_ACEOF+if ac_fn_c_try_compile "$LINENO"; then :+  ac_cv_header_stdc=yes+else+  ac_cv_header_stdc=no+fi+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext++if test $ac_cv_header_stdc = yes; then+  # SunOS 4.x string.h does not declare mem*, contrary to ANSI.+  cat confdefs.h - <<_ACEOF >conftest.$ac_ext+/* end confdefs.h.  */+#include <string.h>++_ACEOF+if (eval "$ac_cpp conftest.$ac_ext") 2>&5 |+  $EGREP "memchr" >/dev/null 2>&1; then :++else+  ac_cv_header_stdc=no+fi+rm -f conftest*++fi++if test $ac_cv_header_stdc = yes; then+  # ISC 2.0.2 stdlib.h does not declare free, contrary to ANSI.+  cat confdefs.h - <<_ACEOF >conftest.$ac_ext+/* end confdefs.h.  */+#include <stdlib.h>++_ACEOF+if (eval "$ac_cpp conftest.$ac_ext") 2>&5 |+  $EGREP "free" >/dev/null 2>&1; then :++else+  ac_cv_header_stdc=no+fi+rm -f conftest*++fi++if test $ac_cv_header_stdc = yes; then+  # /bin/cc in Irix-4.0.5 gets non-ANSI ctype macros unless using -ansi.+  if test "$cross_compiling" = yes; then :+  :+else+  cat confdefs.h - <<_ACEOF >conftest.$ac_ext+/* end confdefs.h.  */+#include <ctype.h>+#include <stdlib.h>+#if ((' ' & 0x0FF) == 0x020)+# define ISLOWER(c) ('a' <= (c) && (c) <= 'z')+# define TOUPPER(c) (ISLOWER(c) ? 'A' + ((c) - 'a') : (c))+#else+# define ISLOWER(c) \+		   (('a' <= (c) && (c) <= 'i') \+		     || ('j' <= (c) && (c) <= 'r') \+		     || ('s' <= (c) && (c) <= 'z'))+# define TOUPPER(c) (ISLOWER(c) ? ((c) | 0x40) : (c))+#endif++#define XOR(e, f) (((e) && !(f)) || (!(e) && (f)))+int+main ()+{+  int i;+  for (i = 0; i < 256; i++)+    if (XOR (islower (i), ISLOWER (i))+	|| toupper (i) != TOUPPER (i))+      return 2;+  return 0;+}+_ACEOF+if ac_fn_c_try_run "$LINENO"; then :++else+  ac_cv_header_stdc=no+fi+rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \+  conftest.$ac_objext conftest.beam conftest.$ac_ext+fi++fi+fi+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_header_stdc" >&5+$as_echo "$ac_cv_header_stdc" >&6; }+if test $ac_cv_header_stdc = yes; then++$as_echo "#define STDC_HEADERS 1" >>confdefs.h++fi++# On IRIX 5.3, sys/types and inttypes.h are conflicting.+for ac_header in sys/types.h sys/stat.h stdlib.h string.h memory.h strings.h \+		  inttypes.h stdint.h unistd.h+do :+  as_ac_Header=`$as_echo "ac_cv_header_$ac_header" | $as_tr_sh`+ac_fn_c_check_header_compile "$LINENO" "$ac_header" "$as_ac_Header" "$ac_includes_default+"+if eval test \"x\$"$as_ac_Header"\" = x"yes"; then :+  cat >>confdefs.h <<_ACEOF+#define `$as_echo "HAVE_$ac_header" | $as_tr_cpp` 1+_ACEOF++fi++done+++ac_fn_c_check_type "$LINENO" "long long" "ac_cv_type_long_long" "$ac_includes_default"+if test "x$ac_cv_type_long_long" = x""yes; then :++cat >>confdefs.h <<_ACEOF+#define HAVE_LONG_LONG 1+_ACEOF+++fi+++{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for ANSI C header files" >&5+$as_echo_n "checking for ANSI C header files... " >&6; }+if test "${ac_cv_header_stdc+set}" = set; then :+  $as_echo_n "(cached) " >&6+else+  cat confdefs.h - <<_ACEOF >conftest.$ac_ext+/* end confdefs.h.  */+#include <stdlib.h>+#include <stdarg.h>+#include <string.h>+#include <float.h>++int+main ()+{++  ;+  return 0;+}+_ACEOF+if ac_fn_c_try_compile "$LINENO"; then :+  ac_cv_header_stdc=yes+else+  ac_cv_header_stdc=no+fi+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext++if test $ac_cv_header_stdc = yes; then+  # SunOS 4.x string.h does not declare mem*, contrary to ANSI.+  cat confdefs.h - <<_ACEOF >conftest.$ac_ext+/* end confdefs.h.  */+#include <string.h>++_ACEOF+if (eval "$ac_cpp conftest.$ac_ext") 2>&5 |+  $EGREP "memchr" >/dev/null 2>&1; then :++else+  ac_cv_header_stdc=no+fi+rm -f conftest*++fi++if test $ac_cv_header_stdc = yes; then+  # ISC 2.0.2 stdlib.h does not declare free, contrary to ANSI.+  cat confdefs.h - <<_ACEOF >conftest.$ac_ext+/* end confdefs.h.  */+#include <stdlib.h>++_ACEOF+if (eval "$ac_cpp conftest.$ac_ext") 2>&5 |+  $EGREP "free" >/dev/null 2>&1; then :++else+  ac_cv_header_stdc=no+fi+rm -f conftest*++fi++if test $ac_cv_header_stdc = yes; then+  # /bin/cc in Irix-4.0.5 gets non-ANSI ctype macros unless using -ansi.+  if test "$cross_compiling" = yes; then :+  :+else+  cat confdefs.h - <<_ACEOF >conftest.$ac_ext+/* end confdefs.h.  */+#include <ctype.h>+#include <stdlib.h>+#if ((' ' & 0x0FF) == 0x020)+# define ISLOWER(c) ('a' <= (c) && (c) <= 'z')+# define TOUPPER(c) (ISLOWER(c) ? 'A' + ((c) - 'a') : (c))+#else+# define ISLOWER(c) \+		   (('a' <= (c) && (c) <= 'i') \+		     || ('j' <= (c) && (c) <= 'r') \+		     || ('s' <= (c) && (c) <= 'z'))+# define TOUPPER(c) (ISLOWER(c) ? ((c) | 0x40) : (c))+#endif++#define XOR(e, f) (((e) && !(f)) || (!(e) && (f)))+int+main ()+{+  int i;+  for (i = 0; i < 256; i++)+    if (XOR (islower (i), ISLOWER (i))+	|| toupper (i) != TOUPPER (i))+      return 2;+  return 0;+}+_ACEOF+if ac_fn_c_try_run "$LINENO"; then :++else+  ac_cv_header_stdc=no+fi+rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \+  conftest.$ac_objext conftest.beam conftest.$ac_ext+fi++fi+fi+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_header_stdc" >&5+$as_echo "$ac_cv_header_stdc" >&6; }+if test $ac_cv_header_stdc = yes; then++$as_echo "#define STDC_HEADERS 1" >>confdefs.h++fi+++# check for specific header (.h) files that we are interested in+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 poll.h sys/epoll.h sys/event.h sys/eventfd.h+do :+  as_ac_Header=`$as_echo "ac_cv_header_$ac_header" | $as_tr_sh`+ac_fn_c_check_header_mongrel "$LINENO" "$ac_header" "$as_ac_Header" "$ac_includes_default"+if eval test \"x\$"$as_ac_Header"\" = x"yes"; then :+  cat >>confdefs.h <<_ACEOF+#define `$as_echo "HAVE_$ac_header" | $as_tr_cpp` 1+_ACEOF++fi++done+++# 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.+# Check whether --enable-largefile was given.+if test "${enable_largefile+set}" = set; then :+  enableval=$enable_largefile;+fi++if test "$enable_largefile" != no; then++  { $as_echo "$as_me:${as_lineno-$LINENO}: checking for special C compiler options needed for large files" >&5+$as_echo_n "checking for special C compiler options needed for large files... " >&6; }+if test "${ac_cv_sys_largefile_CC+set}" = set; then :+  $as_echo_n "(cached) " >&6+else+  ac_cv_sys_largefile_CC=no+     if test "$GCC" != yes; then+       ac_save_CC=$CC+       while :; do+	 # IRIX 6.2 and later do not support large files by default,+	 # so use the C compiler's -n32 option if that helps.+	 cat confdefs.h - <<_ACEOF >conftest.$ac_ext+/* end confdefs.h.  */+#include <sys/types.h>+ /* Check that off_t can represent 2**63 - 1 correctly.+    We can't simply define LARGE_OFF_T to be 9223372036854775807,+    since some C++ compilers masquerading as C compilers+    incorrectly reject 9223372036854775807.  */+#define LARGE_OFF_T (((off_t) 1 << 62) - 1 + ((off_t) 1 << 62))+  int off_t_is_large[(LARGE_OFF_T % 2147483629 == 721+		       && LARGE_OFF_T % 2147483647 == 1)+		      ? 1 : -1];+int+main ()+{++  ;+  return 0;+}+_ACEOF+	 if ac_fn_c_try_compile "$LINENO"; then :+  break+fi+rm -f core conftest.err conftest.$ac_objext+	 CC="$CC -n32"+	 if ac_fn_c_try_compile "$LINENO"; then :+  ac_cv_sys_largefile_CC=' -n32'; break+fi+rm -f core conftest.err conftest.$ac_objext+	 break+       done+       CC=$ac_save_CC+       rm -f conftest.$ac_ext+    fi+fi+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_sys_largefile_CC" >&5+$as_echo "$ac_cv_sys_largefile_CC" >&6; }+  if test "$ac_cv_sys_largefile_CC" != no; then+    CC=$CC$ac_cv_sys_largefile_CC+  fi++  { $as_echo "$as_me:${as_lineno-$LINENO}: checking for _FILE_OFFSET_BITS value needed for large files" >&5+$as_echo_n "checking for _FILE_OFFSET_BITS value needed for large files... " >&6; }+if test "${ac_cv_sys_file_offset_bits+set}" = set; then :+  $as_echo_n "(cached) " >&6+else+  while :; do+  cat confdefs.h - <<_ACEOF >conftest.$ac_ext+/* end confdefs.h.  */+#include <sys/types.h>+ /* Check that off_t can represent 2**63 - 1 correctly.+    We can't simply define LARGE_OFF_T to be 9223372036854775807,+    since some C++ compilers masquerading as C compilers+    incorrectly reject 9223372036854775807.  */+#define LARGE_OFF_T (((off_t) 1 << 62) - 1 + ((off_t) 1 << 62))+  int off_t_is_large[(LARGE_OFF_T % 2147483629 == 721+		       && LARGE_OFF_T % 2147483647 == 1)+		      ? 1 : -1];+int+main ()+{++  ;+  return 0;+}+_ACEOF+if ac_fn_c_try_compile "$LINENO"; then :+  ac_cv_sys_file_offset_bits=no; break+fi+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext+  cat confdefs.h - <<_ACEOF >conftest.$ac_ext+/* end confdefs.h.  */+#define _FILE_OFFSET_BITS 64+#include <sys/types.h>+ /* Check that off_t can represent 2**63 - 1 correctly.+    We can't simply define LARGE_OFF_T to be 9223372036854775807,+    since some C++ compilers masquerading as C compilers+    incorrectly reject 9223372036854775807.  */+#define LARGE_OFF_T (((off_t) 1 << 62) - 1 + ((off_t) 1 << 62))+  int off_t_is_large[(LARGE_OFF_T % 2147483629 == 721+		       && LARGE_OFF_T % 2147483647 == 1)+		      ? 1 : -1];+int+main ()+{++  ;+  return 0;+}+_ACEOF+if ac_fn_c_try_compile "$LINENO"; then :+  ac_cv_sys_file_offset_bits=64; break+fi+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext+  ac_cv_sys_file_offset_bits=unknown+  break+done+fi+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_sys_file_offset_bits" >&5+$as_echo "$ac_cv_sys_file_offset_bits" >&6; }+case $ac_cv_sys_file_offset_bits in #(+  no | unknown) ;;+  *)+cat >>confdefs.h <<_ACEOF+#define _FILE_OFFSET_BITS $ac_cv_sys_file_offset_bits+_ACEOF+;;+esac+rm -rf conftest*+  if test $ac_cv_sys_file_offset_bits = unknown; then+    { $as_echo "$as_me:${as_lineno-$LINENO}: checking for _LARGE_FILES value needed for large files" >&5+$as_echo_n "checking for _LARGE_FILES value needed for large files... " >&6; }+if test "${ac_cv_sys_large_files+set}" = set; then :+  $as_echo_n "(cached) " >&6+else+  while :; do+  cat confdefs.h - <<_ACEOF >conftest.$ac_ext+/* end confdefs.h.  */+#include <sys/types.h>+ /* Check that off_t can represent 2**63 - 1 correctly.+    We can't simply define LARGE_OFF_T to be 9223372036854775807,+    since some C++ compilers masquerading as C compilers+    incorrectly reject 9223372036854775807.  */+#define LARGE_OFF_T (((off_t) 1 << 62) - 1 + ((off_t) 1 << 62))+  int off_t_is_large[(LARGE_OFF_T % 2147483629 == 721+		       && LARGE_OFF_T % 2147483647 == 1)+		      ? 1 : -1];+int+main ()+{++  ;+  return 0;+}+_ACEOF+if ac_fn_c_try_compile "$LINENO"; then :+  ac_cv_sys_large_files=no; break+fi+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext+  cat confdefs.h - <<_ACEOF >conftest.$ac_ext+/* end confdefs.h.  */+#define _LARGE_FILES 1+#include <sys/types.h>+ /* Check that off_t can represent 2**63 - 1 correctly.+    We can't simply define LARGE_OFF_T to be 9223372036854775807,+    since some C++ compilers masquerading as C compilers+    incorrectly reject 9223372036854775807.  */+#define LARGE_OFF_T (((off_t) 1 << 62) - 1 + ((off_t) 1 << 62))+  int off_t_is_large[(LARGE_OFF_T % 2147483629 == 721+		       && LARGE_OFF_T % 2147483647 == 1)+		      ? 1 : -1];+int+main ()+{++  ;+  return 0;+}+_ACEOF+if ac_fn_c_try_compile "$LINENO"; then :+  ac_cv_sys_large_files=1; break+fi+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext+  ac_cv_sys_large_files=unknown+  break+done+fi+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_sys_large_files" >&5+$as_echo "$ac_cv_sys_large_files" >&6; }+case $ac_cv_sys_large_files in #(+  no | unknown) ;;+  *)+cat >>confdefs.h <<_ACEOF+#define _LARGE_FILES $ac_cv_sys_large_files+_ACEOF+;;+esac+rm -rf conftest*+  fi+fi+++for ac_header in wctype.h+do :+  ac_fn_c_check_header_mongrel "$LINENO" "wctype.h" "ac_cv_header_wctype_h" "$ac_includes_default"+if test "x$ac_cv_header_wctype_h" = x""yes; then :+  cat >>confdefs.h <<_ACEOF+#define HAVE_WCTYPE_H 1+_ACEOF+ for ac_func in iswspace+do :+  ac_fn_c_check_func "$LINENO" "iswspace" "ac_cv_func_iswspace"+if test "x$ac_cv_func_iswspace" = x""yes; then :+  cat >>confdefs.h <<_ACEOF+#define HAVE_ISWSPACE 1+_ACEOF++fi+done++fi++done+++for ac_func in lstat+do :+  ac_fn_c_check_func "$LINENO" "lstat" "ac_cv_func_lstat"+if test "x$ac_cv_func_lstat" = x""yes; then :+  cat >>confdefs.h <<_ACEOF+#define HAVE_LSTAT 1+_ACEOF++fi+done++for ac_func in getclock getrusage times+do :+  as_ac_var=`$as_echo "ac_cv_func_$ac_func" | $as_tr_sh`+ac_fn_c_check_func "$LINENO" "$ac_func" "$as_ac_var"+if eval test \"x\$"$as_ac_var"\" = x"yes"; then :+  cat >>confdefs.h <<_ACEOF+#define `$as_echo "HAVE_$ac_func" | $as_tr_cpp` 1+_ACEOF++fi+done++for ac_func in _chsize ftruncate+do :+  as_ac_var=`$as_echo "ac_cv_func_$ac_func" | $as_tr_sh`+ac_fn_c_check_func "$LINENO" "$ac_func" "$as_ac_var"+if eval test \"x\$"$as_ac_var"\" = x"yes"; then :+  cat >>confdefs.h <<_ACEOF+#define `$as_echo "HAVE_$ac_func" | $as_tr_cpp` 1+_ACEOF++fi+done+++for ac_func in epoll_ctl eventfd kevent kevent64 kqueue poll+do :+  as_ac_var=`$as_echo "ac_cv_func_$ac_func" | $as_tr_sh`+ac_fn_c_check_func "$LINENO" "$ac_func" "$as_ac_var"+if eval test \"x\$"$as_ac_var"\" = x"yes"; then :+  cat >>confdefs.h <<_ACEOF+#define `$as_echo "HAVE_$ac_func" | $as_tr_cpp` 1+_ACEOF++fi+done+++# event-related fun++if test "$ac_cv_header_sys_epoll_h" = yes -a "$ac_cv_func_epoll_ctl" = yes; then++$as_echo "#define HAVE_EPOLL 1" >>confdefs.h++fi++if test "$ac_cv_header_sys_event_h" = yes -a "$ac_cv_func_kqueue" = yes; then++$as_echo "#define HAVE_KQUEUE 1" >>confdefs.h++fi++if test "$ac_cv_header_poll_h" = yes -a "$ac_cv_func_poll" = yes; then++$as_echo "#define HAVE_POLL 1" >>confdefs.h++fi++++# 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+++++++++    { $as_echo "$as_me:${as_lineno-$LINENO}: checking Haskell type for char" >&5+$as_echo_n "checking Haskell type for char... " >&6; }+    if test "${fptools_cv_htype_char+set}" = set; then :+  $as_echo_n "(cached) " >&6+else++        fptools_cv_htype_sup_char=yes+        if ac_fn_c_compute_int "$LINENO" "((char)((int)((char)1.4))) == ((char)1.4)" "HTYPE_IS_INTEGRAL"        "+#include <stdio.h>+#include <stddef.h>++#if HAVE_SYS_TYPES_H+# include <sys/types.h>+#endif++#if HAVE_UNISTD_H+# include <unistd.h>+#endif++#if HAVE_SYS_STAT_H+# include <sys/stat.h>+#endif++#if HAVE_FCNTL_H+# include <fcntl.h>+#endif++#if HAVE_SIGNAL_H+# include <signal.h>+#endif++#if HAVE_TIME_H+# include <time.h>+#endif++#if HAVE_TERMIOS_H+# include <termios.h>+#endif++#if HAVE_STRING_H+# include <string.h>+#endif++#if HAVE_CTYPE_H+# include <ctype.h>+#endif++#if HAVE_INTTYPES_H+# include <inttypes.h>+#else+# if HAVE_STDINT_H+#  include <stdint.h>+# endif+#endif++#if HAVE_SYS_RESOURCE_H+# include <sys/resource.h>+#endif++#include <stdlib.h>+"; then :++else+  fptools_cv_htype_sup_char=no+fi+++        if test "$fptools_cv_htype_sup_char" = "yes"+        then+            if test "$HTYPE_IS_INTEGRAL" -eq 0+            then+                if ac_fn_c_compute_int "$LINENO" "sizeof(char) == sizeof(float)" "HTYPE_IS_FLOAT"        "+#include <stdio.h>+#include <stddef.h>++#if HAVE_SYS_TYPES_H+# include <sys/types.h>+#endif++#if HAVE_UNISTD_H+# include <unistd.h>+#endif++#if HAVE_SYS_STAT_H+# include <sys/stat.h>+#endif++#if HAVE_FCNTL_H+# include <fcntl.h>+#endif++#if HAVE_SIGNAL_H+# include <signal.h>+#endif++#if HAVE_TIME_H+# include <time.h>+#endif++#if HAVE_TERMIOS_H+# include <termios.h>+#endif++#if HAVE_STRING_H+# include <string.h>+#endif++#if HAVE_CTYPE_H+# include <ctype.h>+#endif++#if HAVE_INTTYPES_H+# include <inttypes.h>+#else+# if HAVE_STDINT_H+#  include <stdint.h>+# endif+#endif++#if HAVE_SYS_RESOURCE_H+# include <sys/resource.h>+#endif++#include <stdlib.h>+"; then :++else+  fptools_cv_htype_sup_char=no+fi+++                if ac_fn_c_compute_int "$LINENO" "sizeof(char) == sizeof(double)" "HTYPE_IS_DOUBLE"        "+#include <stdio.h>+#include <stddef.h>++#if HAVE_SYS_TYPES_H+# include <sys/types.h>+#endif++#if HAVE_UNISTD_H+# include <unistd.h>+#endif++#if HAVE_SYS_STAT_H+# include <sys/stat.h>+#endif++#if HAVE_FCNTL_H+# include <fcntl.h>+#endif++#if HAVE_SIGNAL_H+# include <signal.h>+#endif++#if HAVE_TIME_H+# include <time.h>+#endif++#if HAVE_TERMIOS_H+# include <termios.h>+#endif++#if HAVE_STRING_H+# include <string.h>+#endif++#if HAVE_CTYPE_H+# include <ctype.h>+#endif++#if HAVE_INTTYPES_H+# include <inttypes.h>+#else+# if HAVE_STDINT_H+#  include <stdint.h>+# endif+#endif++#if HAVE_SYS_RESOURCE_H+# include <sys/resource.h>+#endif++#include <stdlib.h>+"; then :++else+  fptools_cv_htype_sup_char=no+fi+++                if ac_fn_c_compute_int "$LINENO" "sizeof(char) == sizeof(long double)" "HTYPE_IS_LDOUBLE"        "+#include <stdio.h>+#include <stddef.h>++#if HAVE_SYS_TYPES_H+# include <sys/types.h>+#endif++#if HAVE_UNISTD_H+# include <unistd.h>+#endif++#if HAVE_SYS_STAT_H+# include <sys/stat.h>+#endif++#if HAVE_FCNTL_H+# include <fcntl.h>+#endif++#if HAVE_SIGNAL_H+# include <signal.h>+#endif++#if HAVE_TIME_H+# include <time.h>+#endif++#if HAVE_TERMIOS_H+# include <termios.h>+#endif++#if HAVE_STRING_H+# include <string.h>+#endif++#if HAVE_CTYPE_H+# include <ctype.h>+#endif++#if HAVE_INTTYPES_H+# include <inttypes.h>+#else+# if HAVE_STDINT_H+#  include <stdint.h>+# endif+#endif++#if HAVE_SYS_RESOURCE_H+# include <sys/resource.h>+#endif++#include <stdlib.h>+"; then :++else+  fptools_cv_htype_sup_char=no+fi+++                if test "$HTYPE_IS_FLOAT" -eq 1+                then+                    fptools_cv_htype_char=Float+                elif test "$HTYPE_IS_DOUBLE" -eq 1+                then+                    fptools_cv_htype_char=Double+                elif test "$HTYPE_IS_LDOUBLE" -eq 1+                then+                    fptools_cv_htype_char=LDouble+                else+                    fptools_cv_htype_sup_char=no+                fi+            else+                if ac_fn_c_compute_int "$LINENO" "((char)(-1)) < ((char)0)" "HTYPE_IS_SIGNED"        "+#include <stdio.h>+#include <stddef.h>++#if HAVE_SYS_TYPES_H+# include <sys/types.h>+#endif++#if HAVE_UNISTD_H+# include <unistd.h>+#endif++#if HAVE_SYS_STAT_H+# include <sys/stat.h>+#endif++#if HAVE_FCNTL_H+# include <fcntl.h>+#endif++#if HAVE_SIGNAL_H+# include <signal.h>+#endif++#if HAVE_TIME_H+# include <time.h>+#endif++#if HAVE_TERMIOS_H+# include <termios.h>+#endif++#if HAVE_STRING_H+# include <string.h>+#endif++#if HAVE_CTYPE_H+# include <ctype.h>+#endif++#if HAVE_INTTYPES_H+# include <inttypes.h>+#else+# if HAVE_STDINT_H+#  include <stdint.h>+# endif+#endif++#if HAVE_SYS_RESOURCE_H+# include <sys/resource.h>+#endif++#include <stdlib.h>+"; then :++else+  fptools_cv_htype_sup_char=no+fi+++                if ac_fn_c_compute_int "$LINENO" "sizeof(char) * 8" "HTYPE_SIZE"        "+#include <stdio.h>+#include <stddef.h>++#if HAVE_SYS_TYPES_H+# include <sys/types.h>+#endif++#if HAVE_UNISTD_H+# include <unistd.h>+#endif++#if HAVE_SYS_STAT_H+# include <sys/stat.h>+#endif++#if HAVE_FCNTL_H+# include <fcntl.h>+#endif++#if HAVE_SIGNAL_H+# include <signal.h>+#endif++#if HAVE_TIME_H+# include <time.h>+#endif++#if HAVE_TERMIOS_H+# include <termios.h>+#endif++#if HAVE_STRING_H+# include <string.h>+#endif++#if HAVE_CTYPE_H+# include <ctype.h>+#endif++#if HAVE_INTTYPES_H+# include <inttypes.h>+#else+# if HAVE_STDINT_H+#  include <stdint.h>+# endif+#endif++#if HAVE_SYS_RESOURCE_H+# include <sys/resource.h>+#endif++#include <stdlib.h>+"; then :++else+  fptools_cv_htype_sup_char=no+fi+++                if test "$HTYPE_IS_SIGNED" -eq 0+                then+                    fptools_cv_htype_char="Word$HTYPE_SIZE"+                else+                    fptools_cv_htype_char="Int$HTYPE_SIZE"+                fi+            fi+        fi++fi++    if test "$fptools_cv_htype_sup_char" = no+    then++        fptools_cv_htype_char=NotReallyAType+        { $as_echo "$as_me:${as_lineno-$LINENO}: result: not supported" >&5+$as_echo "not supported" >&6; }++    fi++            if test "$fptools_cv_htype_sup_char" = yes; then+        { $as_echo "$as_me:${as_lineno-$LINENO}: result: $fptools_cv_htype_char" >&5+$as_echo "$fptools_cv_htype_char" >&6; }++cat >>confdefs.h <<_ACEOF+#define HTYPE_CHAR $fptools_cv_htype_char+_ACEOF++    fi+++++++++++    { $as_echo "$as_me:${as_lineno-$LINENO}: checking Haskell type for signed char" >&5+$as_echo_n "checking Haskell type for signed char... " >&6; }+    if test "${fptools_cv_htype_signed_char+set}" = set; then :+  $as_echo_n "(cached) " >&6+else++        fptools_cv_htype_sup_signed_char=yes+        if ac_fn_c_compute_int "$LINENO" "((signed char)((int)((signed char)1.4))) == ((signed char)1.4)" "HTYPE_IS_INTEGRAL"        "+#include <stdio.h>+#include <stddef.h>++#if HAVE_SYS_TYPES_H+# include <sys/types.h>+#endif++#if HAVE_UNISTD_H+# include <unistd.h>+#endif++#if HAVE_SYS_STAT_H+# include <sys/stat.h>+#endif++#if HAVE_FCNTL_H+# include <fcntl.h>+#endif++#if HAVE_SIGNAL_H+# include <signal.h>+#endif++#if HAVE_TIME_H+# include <time.h>+#endif++#if HAVE_TERMIOS_H+# include <termios.h>+#endif++#if HAVE_STRING_H+# include <string.h>+#endif++#if HAVE_CTYPE_H+# include <ctype.h>+#endif++#if HAVE_INTTYPES_H+# include <inttypes.h>+#else+# if HAVE_STDINT_H+#  include <stdint.h>+# endif+#endif++#if HAVE_SYS_RESOURCE_H+# include <sys/resource.h>+#endif++#include <stdlib.h>+"; then :++else+  fptools_cv_htype_sup_signed_char=no+fi+++        if test "$fptools_cv_htype_sup_signed_char" = "yes"+        then+            if test "$HTYPE_IS_INTEGRAL" -eq 0+            then+                if ac_fn_c_compute_int "$LINENO" "sizeof(signed char) == sizeof(float)" "HTYPE_IS_FLOAT"        "+#include <stdio.h>+#include <stddef.h>++#if HAVE_SYS_TYPES_H+# include <sys/types.h>+#endif++#if HAVE_UNISTD_H+# include <unistd.h>+#endif++#if HAVE_SYS_STAT_H+# include <sys/stat.h>+#endif++#if HAVE_FCNTL_H+# include <fcntl.h>+#endif++#if HAVE_SIGNAL_H+# include <signal.h>+#endif++#if HAVE_TIME_H+# include <time.h>+#endif++#if HAVE_TERMIOS_H+# include <termios.h>+#endif++#if HAVE_STRING_H+# include <string.h>+#endif++#if HAVE_CTYPE_H+# include <ctype.h>+#endif++#if HAVE_INTTYPES_H+# include <inttypes.h>+#else+# if HAVE_STDINT_H+#  include <stdint.h>+# endif+#endif++#if HAVE_SYS_RESOURCE_H+# include <sys/resource.h>+#endif++#include <stdlib.h>+"; then :++else+  fptools_cv_htype_sup_signed_char=no+fi+++                if ac_fn_c_compute_int "$LINENO" "sizeof(signed char) == sizeof(double)" "HTYPE_IS_DOUBLE"        "+#include <stdio.h>+#include <stddef.h>++#if HAVE_SYS_TYPES_H+# include <sys/types.h>+#endif++#if HAVE_UNISTD_H+# include <unistd.h>+#endif++#if HAVE_SYS_STAT_H+# include <sys/stat.h>+#endif++#if HAVE_FCNTL_H+# include <fcntl.h>+#endif++#if HAVE_SIGNAL_H+# include <signal.h>+#endif++#if HAVE_TIME_H+# include <time.h>+#endif++#if HAVE_TERMIOS_H+# include <termios.h>+#endif++#if HAVE_STRING_H+# include <string.h>+#endif++#if HAVE_CTYPE_H+# include <ctype.h>+#endif++#if HAVE_INTTYPES_H+# include <inttypes.h>+#else+# if HAVE_STDINT_H+#  include <stdint.h>+# endif+#endif++#if HAVE_SYS_RESOURCE_H+# include <sys/resource.h>+#endif++#include <stdlib.h>+"; then :++else+  fptools_cv_htype_sup_signed_char=no+fi+++                if ac_fn_c_compute_int "$LINENO" "sizeof(signed char) == sizeof(long double)" "HTYPE_IS_LDOUBLE"        "+#include <stdio.h>+#include <stddef.h>++#if HAVE_SYS_TYPES_H+# include <sys/types.h>+#endif++#if HAVE_UNISTD_H+# include <unistd.h>+#endif++#if HAVE_SYS_STAT_H+# include <sys/stat.h>+#endif++#if HAVE_FCNTL_H+# include <fcntl.h>+#endif++#if HAVE_SIGNAL_H+# include <signal.h>+#endif++#if HAVE_TIME_H+# include <time.h>+#endif++#if HAVE_TERMIOS_H+# include <termios.h>+#endif++#if HAVE_STRING_H+# include <string.h>+#endif++#if HAVE_CTYPE_H+# include <ctype.h>+#endif++#if HAVE_INTTYPES_H+# include <inttypes.h>+#else+# if HAVE_STDINT_H+#  include <stdint.h>+# endif+#endif++#if HAVE_SYS_RESOURCE_H+# include <sys/resource.h>+#endif++#include <stdlib.h>+"; then :++else+  fptools_cv_htype_sup_signed_char=no+fi+++                if test "$HTYPE_IS_FLOAT" -eq 1+                then+                    fptools_cv_htype_signed_char=Float+                elif test "$HTYPE_IS_DOUBLE" -eq 1+                then+                    fptools_cv_htype_signed_char=Double+                elif test "$HTYPE_IS_LDOUBLE" -eq 1+                then+                    fptools_cv_htype_signed_char=LDouble+                else+                    fptools_cv_htype_sup_signed_char=no+                fi+            else+                if ac_fn_c_compute_int "$LINENO" "((signed char)(-1)) < ((signed char)0)" "HTYPE_IS_SIGNED"        "+#include <stdio.h>+#include <stddef.h>++#if HAVE_SYS_TYPES_H+# include <sys/types.h>+#endif++#if HAVE_UNISTD_H+# include <unistd.h>+#endif++#if HAVE_SYS_STAT_H+# include <sys/stat.h>+#endif++#if HAVE_FCNTL_H+# include <fcntl.h>+#endif++#if HAVE_SIGNAL_H+# include <signal.h>+#endif++#if HAVE_TIME_H+# include <time.h>+#endif++#if HAVE_TERMIOS_H+# include <termios.h>+#endif++#if HAVE_STRING_H+# include <string.h>+#endif++#if HAVE_CTYPE_H+# include <ctype.h>+#endif++#if HAVE_INTTYPES_H+# include <inttypes.h>+#else+# if HAVE_STDINT_H+#  include <stdint.h>+# endif+#endif++#if HAVE_SYS_RESOURCE_H+# include <sys/resource.h>+#endif++#include <stdlib.h>+"; then :++else+  fptools_cv_htype_sup_signed_char=no+fi+++                if ac_fn_c_compute_int "$LINENO" "sizeof(signed char) * 8" "HTYPE_SIZE"        "+#include <stdio.h>+#include <stddef.h>++#if HAVE_SYS_TYPES_H+# include <sys/types.h>+#endif++#if HAVE_UNISTD_H+# include <unistd.h>+#endif++#if HAVE_SYS_STAT_H+# include <sys/stat.h>+#endif++#if HAVE_FCNTL_H+# include <fcntl.h>+#endif++#if HAVE_SIGNAL_H+# include <signal.h>+#endif++#if HAVE_TIME_H+# include <time.h>+#endif++#if HAVE_TERMIOS_H+# include <termios.h>+#endif++#if HAVE_STRING_H+# include <string.h>+#endif++#if HAVE_CTYPE_H+# include <ctype.h>+#endif++#if HAVE_INTTYPES_H+# include <inttypes.h>+#else+# if HAVE_STDINT_H+#  include <stdint.h>+# endif+#endif++#if HAVE_SYS_RESOURCE_H+# include <sys/resource.h>+#endif++#include <stdlib.h>+"; then :++else+  fptools_cv_htype_sup_signed_char=no+fi+++                if test "$HTYPE_IS_SIGNED" -eq 0+                then+                    fptools_cv_htype_signed_char="Word$HTYPE_SIZE"+                else+                    fptools_cv_htype_signed_char="Int$HTYPE_SIZE"+                fi+            fi+        fi++fi++    if test "$fptools_cv_htype_sup_signed_char" = no+    then++        fptools_cv_htype_signed_char=NotReallyAType+        { $as_echo "$as_me:${as_lineno-$LINENO}: result: not supported" >&5+$as_echo "not supported" >&6; }++    fi++            if test "$fptools_cv_htype_sup_signed_char" = yes; then+        { $as_echo "$as_me:${as_lineno-$LINENO}: result: $fptools_cv_htype_signed_char" >&5+$as_echo "$fptools_cv_htype_signed_char" >&6; }++cat >>confdefs.h <<_ACEOF+#define HTYPE_SIGNED_CHAR $fptools_cv_htype_signed_char+_ACEOF++    fi+++++++++++    { $as_echo "$as_me:${as_lineno-$LINENO}: checking Haskell type for unsigned char" >&5+$as_echo_n "checking Haskell type for unsigned char... " >&6; }+    if test "${fptools_cv_htype_unsigned_char+set}" = set; then :+  $as_echo_n "(cached) " >&6+else++        fptools_cv_htype_sup_unsigned_char=yes+        if ac_fn_c_compute_int "$LINENO" "((unsigned char)((int)((unsigned char)1.4))) == ((unsigned char)1.4)" "HTYPE_IS_INTEGRAL"        "+#include <stdio.h>+#include <stddef.h>++#if HAVE_SYS_TYPES_H+# include <sys/types.h>+#endif++#if HAVE_UNISTD_H+# include <unistd.h>+#endif++#if HAVE_SYS_STAT_H+# include <sys/stat.h>+#endif++#if HAVE_FCNTL_H+# include <fcntl.h>+#endif++#if HAVE_SIGNAL_H+# include <signal.h>+#endif++#if HAVE_TIME_H+# include <time.h>+#endif++#if HAVE_TERMIOS_H+# include <termios.h>+#endif++#if HAVE_STRING_H+# include <string.h>+#endif++#if HAVE_CTYPE_H+# include <ctype.h>+#endif++#if HAVE_INTTYPES_H+# include <inttypes.h>+#else+# if HAVE_STDINT_H+#  include <stdint.h>+# endif+#endif++#if HAVE_SYS_RESOURCE_H+# include <sys/resource.h>+#endif++#include <stdlib.h>+"; then :++else+  fptools_cv_htype_sup_unsigned_char=no+fi+++        if test "$fptools_cv_htype_sup_unsigned_char" = "yes"+        then+            if test "$HTYPE_IS_INTEGRAL" -eq 0+            then+                if ac_fn_c_compute_int "$LINENO" "sizeof(unsigned char) == sizeof(float)" "HTYPE_IS_FLOAT"        "+#include <stdio.h>+#include <stddef.h>++#if HAVE_SYS_TYPES_H+# include <sys/types.h>+#endif++#if HAVE_UNISTD_H+# include <unistd.h>+#endif++#if HAVE_SYS_STAT_H+# include <sys/stat.h>+#endif++#if HAVE_FCNTL_H+# include <fcntl.h>+#endif++#if HAVE_SIGNAL_H+# include <signal.h>+#endif++#if HAVE_TIME_H+# include <time.h>+#endif++#if HAVE_TERMIOS_H+# include <termios.h>+#endif++#if HAVE_STRING_H+# include <string.h>+#endif++#if HAVE_CTYPE_H+# include <ctype.h>+#endif++#if HAVE_INTTYPES_H+# include <inttypes.h>+#else+# if HAVE_STDINT_H+#  include <stdint.h>+# endif+#endif++#if HAVE_SYS_RESOURCE_H+# include <sys/resource.h>+#endif++#include <stdlib.h>+"; then :++else+  fptools_cv_htype_sup_unsigned_char=no+fi+++                if ac_fn_c_compute_int "$LINENO" "sizeof(unsigned char) == sizeof(double)" "HTYPE_IS_DOUBLE"        "+#include <stdio.h>+#include <stddef.h>++#if HAVE_SYS_TYPES_H+# include <sys/types.h>+#endif++#if HAVE_UNISTD_H+# include <unistd.h>+#endif++#if HAVE_SYS_STAT_H+# include <sys/stat.h>+#endif++#if HAVE_FCNTL_H+# include <fcntl.h>+#endif++#if HAVE_SIGNAL_H+# include <signal.h>+#endif++#if HAVE_TIME_H+# include <time.h>+#endif++#if HAVE_TERMIOS_H+# include <termios.h>+#endif++#if HAVE_STRING_H+# include <string.h>+#endif++#if HAVE_CTYPE_H+# include <ctype.h>+#endif++#if HAVE_INTTYPES_H+# include <inttypes.h>+#else+# if HAVE_STDINT_H+#  include <stdint.h>+# endif+#endif++#if HAVE_SYS_RESOURCE_H+# include <sys/resource.h>+#endif++#include <stdlib.h>+"; then :++else+  fptools_cv_htype_sup_unsigned_char=no+fi+++                if ac_fn_c_compute_int "$LINENO" "sizeof(unsigned char) == sizeof(long double)" "HTYPE_IS_LDOUBLE"        "+#include <stdio.h>+#include <stddef.h>++#if HAVE_SYS_TYPES_H+# include <sys/types.h>+#endif++#if HAVE_UNISTD_H+# include <unistd.h>+#endif++#if HAVE_SYS_STAT_H+# include <sys/stat.h>+#endif++#if HAVE_FCNTL_H+# include <fcntl.h>+#endif++#if HAVE_SIGNAL_H+# include <signal.h>+#endif++#if HAVE_TIME_H+# include <time.h>+#endif++#if HAVE_TERMIOS_H+# include <termios.h>+#endif++#if HAVE_STRING_H+# include <string.h>+#endif++#if HAVE_CTYPE_H+# include <ctype.h>+#endif++#if HAVE_INTTYPES_H+# include <inttypes.h>+#else+# if HAVE_STDINT_H+#  include <stdint.h>+# endif+#endif++#if HAVE_SYS_RESOURCE_H+# include <sys/resource.h>+#endif++#include <stdlib.h>+"; then :++else+  fptools_cv_htype_sup_unsigned_char=no+fi+++                if test "$HTYPE_IS_FLOAT" -eq 1+                then+                    fptools_cv_htype_unsigned_char=Float+                elif test "$HTYPE_IS_DOUBLE" -eq 1+                then+                    fptools_cv_htype_unsigned_char=Double+                elif test "$HTYPE_IS_LDOUBLE" -eq 1+                then+                    fptools_cv_htype_unsigned_char=LDouble+                else+                    fptools_cv_htype_sup_unsigned_char=no+                fi+            else+                if ac_fn_c_compute_int "$LINENO" "((unsigned char)(-1)) < ((unsigned char)0)" "HTYPE_IS_SIGNED"        "+#include <stdio.h>+#include <stddef.h>++#if HAVE_SYS_TYPES_H+# include <sys/types.h>+#endif++#if HAVE_UNISTD_H+# include <unistd.h>+#endif++#if HAVE_SYS_STAT_H+# include <sys/stat.h>+#endif++#if HAVE_FCNTL_H+# include <fcntl.h>+#endif++#if HAVE_SIGNAL_H+# include <signal.h>+#endif++#if HAVE_TIME_H+# include <time.h>+#endif++#if HAVE_TERMIOS_H+# include <termios.h>+#endif++#if HAVE_STRING_H+# include <string.h>+#endif++#if HAVE_CTYPE_H+# include <ctype.h>+#endif++#if HAVE_INTTYPES_H+# include <inttypes.h>+#else+# if HAVE_STDINT_H+#  include <stdint.h>+# endif+#endif++#if HAVE_SYS_RESOURCE_H+# include <sys/resource.h>+#endif++#include <stdlib.h>+"; then :++else+  fptools_cv_htype_sup_unsigned_char=no+fi+++                if ac_fn_c_compute_int "$LINENO" "sizeof(unsigned char) * 8" "HTYPE_SIZE"        "+#include <stdio.h>+#include <stddef.h>++#if HAVE_SYS_TYPES_H+# include <sys/types.h>+#endif++#if HAVE_UNISTD_H+# include <unistd.h>+#endif++#if HAVE_SYS_STAT_H+# include <sys/stat.h>+#endif++#if HAVE_FCNTL_H+# include <fcntl.h>+#endif++#if HAVE_SIGNAL_H+# include <signal.h>+#endif++#if HAVE_TIME_H+# include <time.h>+#endif++#if HAVE_TERMIOS_H+# include <termios.h>+#endif++#if HAVE_STRING_H+# include <string.h>+#endif++#if HAVE_CTYPE_H+# include <ctype.h>+#endif++#if HAVE_INTTYPES_H+# include <inttypes.h>+#else+# if HAVE_STDINT_H+#  include <stdint.h>+# endif+#endif++#if HAVE_SYS_RESOURCE_H+# include <sys/resource.h>+#endif++#include <stdlib.h>+"; then :++else+  fptools_cv_htype_sup_unsigned_char=no+fi+++                if test "$HTYPE_IS_SIGNED" -eq 0+                then+                    fptools_cv_htype_unsigned_char="Word$HTYPE_SIZE"+                else+                    fptools_cv_htype_unsigned_char="Int$HTYPE_SIZE"+                fi+            fi+        fi++fi++    if test "$fptools_cv_htype_sup_unsigned_char" = no+    then++        fptools_cv_htype_unsigned_char=NotReallyAType+        { $as_echo "$as_me:${as_lineno-$LINENO}: result: not supported" >&5+$as_echo "not supported" >&6; }++    fi++            if test "$fptools_cv_htype_sup_unsigned_char" = yes; then+        { $as_echo "$as_me:${as_lineno-$LINENO}: result: $fptools_cv_htype_unsigned_char" >&5+$as_echo "$fptools_cv_htype_unsigned_char" >&6; }++cat >>confdefs.h <<_ACEOF+#define HTYPE_UNSIGNED_CHAR $fptools_cv_htype_unsigned_char+_ACEOF++    fi+++++++++++    { $as_echo "$as_me:${as_lineno-$LINENO}: checking Haskell type for short" >&5+$as_echo_n "checking Haskell type for short... " >&6; }+    if test "${fptools_cv_htype_short+set}" = set; then :+  $as_echo_n "(cached) " >&6+else++        fptools_cv_htype_sup_short=yes+        if ac_fn_c_compute_int "$LINENO" "((short)((int)((short)1.4))) == ((short)1.4)" "HTYPE_IS_INTEGRAL"        "+#include <stdio.h>+#include <stddef.h>++#if HAVE_SYS_TYPES_H+# include <sys/types.h>+#endif++#if HAVE_UNISTD_H+# include <unistd.h>+#endif++#if HAVE_SYS_STAT_H+# include <sys/stat.h>+#endif++#if HAVE_FCNTL_H+# include <fcntl.h>+#endif++#if HAVE_SIGNAL_H+# include <signal.h>+#endif++#if HAVE_TIME_H+# include <time.h>+#endif++#if HAVE_TERMIOS_H+# include <termios.h>+#endif++#if HAVE_STRING_H+# include <string.h>+#endif++#if HAVE_CTYPE_H+# include <ctype.h>+#endif++#if HAVE_INTTYPES_H+# include <inttypes.h>+#else+# if HAVE_STDINT_H+#  include <stdint.h>+# endif+#endif++#if HAVE_SYS_RESOURCE_H+# include <sys/resource.h>+#endif++#include <stdlib.h>+"; then :++else+  fptools_cv_htype_sup_short=no+fi+++        if test "$fptools_cv_htype_sup_short" = "yes"+        then+            if test "$HTYPE_IS_INTEGRAL" -eq 0+            then+                if ac_fn_c_compute_int "$LINENO" "sizeof(short) == sizeof(float)" "HTYPE_IS_FLOAT"        "+#include <stdio.h>+#include <stddef.h>++#if HAVE_SYS_TYPES_H+# include <sys/types.h>+#endif++#if HAVE_UNISTD_H+# include <unistd.h>+#endif++#if HAVE_SYS_STAT_H+# include <sys/stat.h>+#endif++#if HAVE_FCNTL_H+# include <fcntl.h>+#endif++#if HAVE_SIGNAL_H+# include <signal.h>+#endif++#if HAVE_TIME_H+# include <time.h>+#endif++#if HAVE_TERMIOS_H+# include <termios.h>+#endif++#if HAVE_STRING_H+# include <string.h>+#endif++#if HAVE_CTYPE_H+# include <ctype.h>+#endif++#if HAVE_INTTYPES_H+# include <inttypes.h>+#else+# if HAVE_STDINT_H+#  include <stdint.h>+# endif+#endif++#if HAVE_SYS_RESOURCE_H+# include <sys/resource.h>+#endif++#include <stdlib.h>+"; then :++else+  fptools_cv_htype_sup_short=no+fi+++                if ac_fn_c_compute_int "$LINENO" "sizeof(short) == sizeof(double)" "HTYPE_IS_DOUBLE"        "+#include <stdio.h>+#include <stddef.h>++#if HAVE_SYS_TYPES_H+# include <sys/types.h>+#endif++#if HAVE_UNISTD_H+# include <unistd.h>+#endif++#if HAVE_SYS_STAT_H+# include <sys/stat.h>+#endif++#if HAVE_FCNTL_H+# include <fcntl.h>+#endif++#if HAVE_SIGNAL_H+# include <signal.h>+#endif++#if HAVE_TIME_H+# include <time.h>+#endif++#if HAVE_TERMIOS_H+# include <termios.h>+#endif++#if HAVE_STRING_H+# include <string.h>+#endif++#if HAVE_CTYPE_H+# include <ctype.h>+#endif++#if HAVE_INTTYPES_H+# include <inttypes.h>+#else+# if HAVE_STDINT_H+#  include <stdint.h>+# endif+#endif++#if HAVE_SYS_RESOURCE_H+# include <sys/resource.h>+#endif++#include <stdlib.h>+"; then :++else+  fptools_cv_htype_sup_short=no+fi+++                if ac_fn_c_compute_int "$LINENO" "sizeof(short) == sizeof(long double)" "HTYPE_IS_LDOUBLE"        "+#include <stdio.h>+#include <stddef.h>++#if HAVE_SYS_TYPES_H+# include <sys/types.h>+#endif++#if HAVE_UNISTD_H+# include <unistd.h>+#endif++#if HAVE_SYS_STAT_H+# include <sys/stat.h>+#endif++#if HAVE_FCNTL_H+# include <fcntl.h>+#endif++#if HAVE_SIGNAL_H+# include <signal.h>+#endif++#if HAVE_TIME_H+# include <time.h>+#endif++#if HAVE_TERMIOS_H+# include <termios.h>+#endif++#if HAVE_STRING_H+# include <string.h>+#endif++#if HAVE_CTYPE_H+# include <ctype.h>+#endif++#if HAVE_INTTYPES_H+# include <inttypes.h>+#else+# if HAVE_STDINT_H+#  include <stdint.h>+# endif+#endif++#if HAVE_SYS_RESOURCE_H+# include <sys/resource.h>+#endif++#include <stdlib.h>+"; then :++else+  fptools_cv_htype_sup_short=no+fi+++                if test "$HTYPE_IS_FLOAT" -eq 1+                then+                    fptools_cv_htype_short=Float+                elif test "$HTYPE_IS_DOUBLE" -eq 1+                then+                    fptools_cv_htype_short=Double+                elif test "$HTYPE_IS_LDOUBLE" -eq 1+                then+                    fptools_cv_htype_short=LDouble+                else+                    fptools_cv_htype_sup_short=no+                fi+            else+                if ac_fn_c_compute_int "$LINENO" "((short)(-1)) < ((short)0)" "HTYPE_IS_SIGNED"        "+#include <stdio.h>+#include <stddef.h>++#if HAVE_SYS_TYPES_H+# include <sys/types.h>+#endif++#if HAVE_UNISTD_H+# include <unistd.h>+#endif++#if HAVE_SYS_STAT_H+# include <sys/stat.h>+#endif++#if HAVE_FCNTL_H+# include <fcntl.h>+#endif++#if HAVE_SIGNAL_H+# include <signal.h>+#endif++#if HAVE_TIME_H+# include <time.h>+#endif++#if HAVE_TERMIOS_H+# include <termios.h>+#endif++#if HAVE_STRING_H+# include <string.h>+#endif++#if HAVE_CTYPE_H+# include <ctype.h>+#endif++#if HAVE_INTTYPES_H+# include <inttypes.h>+#else+# if HAVE_STDINT_H+#  include <stdint.h>+# endif+#endif++#if HAVE_SYS_RESOURCE_H+# include <sys/resource.h>+#endif++#include <stdlib.h>+"; then :++else+  fptools_cv_htype_sup_short=no+fi+++                if ac_fn_c_compute_int "$LINENO" "sizeof(short) * 8" "HTYPE_SIZE"        "+#include <stdio.h>+#include <stddef.h>++#if HAVE_SYS_TYPES_H+# include <sys/types.h>+#endif++#if HAVE_UNISTD_H+# include <unistd.h>+#endif++#if HAVE_SYS_STAT_H+# include <sys/stat.h>+#endif++#if HAVE_FCNTL_H+# include <fcntl.h>+#endif++#if HAVE_SIGNAL_H+# include <signal.h>+#endif++#if HAVE_TIME_H+# include <time.h>+#endif++#if HAVE_TERMIOS_H+# include <termios.h>+#endif++#if HAVE_STRING_H+# include <string.h>+#endif++#if HAVE_CTYPE_H+# include <ctype.h>+#endif++#if HAVE_INTTYPES_H+# include <inttypes.h>+#else+# if HAVE_STDINT_H+#  include <stdint.h>+# endif+#endif++#if HAVE_SYS_RESOURCE_H+# include <sys/resource.h>+#endif++#include <stdlib.h>+"; then :++else+  fptools_cv_htype_sup_short=no+fi+++                if test "$HTYPE_IS_SIGNED" -eq 0+                then+                    fptools_cv_htype_short="Word$HTYPE_SIZE"+                else+                    fptools_cv_htype_short="Int$HTYPE_SIZE"+                fi+            fi+        fi++fi++    if test "$fptools_cv_htype_sup_short" = no+    then++        fptools_cv_htype_short=NotReallyAType+        { $as_echo "$as_me:${as_lineno-$LINENO}: result: not supported" >&5+$as_echo "not supported" >&6; }++    fi++            if test "$fptools_cv_htype_sup_short" = yes; then+        { $as_echo "$as_me:${as_lineno-$LINENO}: result: $fptools_cv_htype_short" >&5+$as_echo "$fptools_cv_htype_short" >&6; }++cat >>confdefs.h <<_ACEOF+#define HTYPE_SHORT $fptools_cv_htype_short+_ACEOF++    fi+++++++++++    { $as_echo "$as_me:${as_lineno-$LINENO}: checking Haskell type for unsigned short" >&5+$as_echo_n "checking Haskell type for unsigned short... " >&6; }+    if test "${fptools_cv_htype_unsigned_short+set}" = set; then :+  $as_echo_n "(cached) " >&6+else++        fptools_cv_htype_sup_unsigned_short=yes+        if ac_fn_c_compute_int "$LINENO" "((unsigned short)((int)((unsigned short)1.4))) == ((unsigned short)1.4)" "HTYPE_IS_INTEGRAL"        "+#include <stdio.h>+#include <stddef.h>++#if HAVE_SYS_TYPES_H+# include <sys/types.h>+#endif++#if HAVE_UNISTD_H+# include <unistd.h>+#endif++#if HAVE_SYS_STAT_H+# include <sys/stat.h>+#endif++#if HAVE_FCNTL_H+# include <fcntl.h>+#endif++#if HAVE_SIGNAL_H+# include <signal.h>+#endif++#if HAVE_TIME_H+# include <time.h>+#endif++#if HAVE_TERMIOS_H+# include <termios.h>+#endif++#if HAVE_STRING_H+# include <string.h>+#endif++#if HAVE_CTYPE_H+# include <ctype.h>+#endif++#if HAVE_INTTYPES_H+# include <inttypes.h>+#else+# if HAVE_STDINT_H+#  include <stdint.h>+# endif+#endif++#if HAVE_SYS_RESOURCE_H+# include <sys/resource.h>+#endif++#include <stdlib.h>+"; then :++else+  fptools_cv_htype_sup_unsigned_short=no+fi+++        if test "$fptools_cv_htype_sup_unsigned_short" = "yes"+        then+            if test "$HTYPE_IS_INTEGRAL" -eq 0+            then+                if ac_fn_c_compute_int "$LINENO" "sizeof(unsigned short) == sizeof(float)" "HTYPE_IS_FLOAT"        "+#include <stdio.h>+#include <stddef.h>++#if HAVE_SYS_TYPES_H+# include <sys/types.h>+#endif++#if HAVE_UNISTD_H+# include <unistd.h>+#endif++#if HAVE_SYS_STAT_H+# include <sys/stat.h>+#endif++#if HAVE_FCNTL_H+# include <fcntl.h>+#endif++#if HAVE_SIGNAL_H+# include <signal.h>+#endif++#if HAVE_TIME_H+# include <time.h>+#endif++#if HAVE_TERMIOS_H+# include <termios.h>+#endif++#if HAVE_STRING_H+# include <string.h>+#endif++#if HAVE_CTYPE_H+# include <ctype.h>+#endif++#if HAVE_INTTYPES_H+# include <inttypes.h>+#else+# if HAVE_STDINT_H+#  include <stdint.h>+# endif+#endif++#if HAVE_SYS_RESOURCE_H+# include <sys/resource.h>+#endif++#include <stdlib.h>+"; then :++else+  fptools_cv_htype_sup_unsigned_short=no+fi+++                if ac_fn_c_compute_int "$LINENO" "sizeof(unsigned short) == sizeof(double)" "HTYPE_IS_DOUBLE"        "+#include <stdio.h>+#include <stddef.h>++#if HAVE_SYS_TYPES_H+# include <sys/types.h>+#endif++#if HAVE_UNISTD_H+# include <unistd.h>+#endif++#if HAVE_SYS_STAT_H+# include <sys/stat.h>+#endif++#if HAVE_FCNTL_H+# include <fcntl.h>+#endif++#if HAVE_SIGNAL_H+# include <signal.h>+#endif++#if HAVE_TIME_H+# include <time.h>+#endif++#if HAVE_TERMIOS_H+# include <termios.h>+#endif++#if HAVE_STRING_H+# include <string.h>+#endif++#if HAVE_CTYPE_H+# include <ctype.h>+#endif++#if HAVE_INTTYPES_H+# include <inttypes.h>+#else+# if HAVE_STDINT_H+#  include <stdint.h>+# endif+#endif++#if HAVE_SYS_RESOURCE_H+# include <sys/resource.h>+#endif++#include <stdlib.h>+"; then :++else+  fptools_cv_htype_sup_unsigned_short=no+fi+++                if ac_fn_c_compute_int "$LINENO" "sizeof(unsigned short) == sizeof(long double)" "HTYPE_IS_LDOUBLE"        "+#include <stdio.h>+#include <stddef.h>++#if HAVE_SYS_TYPES_H+# include <sys/types.h>+#endif++#if HAVE_UNISTD_H+# include <unistd.h>+#endif++#if HAVE_SYS_STAT_H+# include <sys/stat.h>+#endif++#if HAVE_FCNTL_H+# include <fcntl.h>+#endif++#if HAVE_SIGNAL_H+# include <signal.h>+#endif++#if HAVE_TIME_H+# include <time.h>+#endif++#if HAVE_TERMIOS_H+# include <termios.h>+#endif++#if HAVE_STRING_H+# include <string.h>+#endif++#if HAVE_CTYPE_H+# include <ctype.h>+#endif++#if HAVE_INTTYPES_H+# include <inttypes.h>+#else+# if HAVE_STDINT_H+#  include <stdint.h>+# endif+#endif++#if HAVE_SYS_RESOURCE_H+# include <sys/resource.h>+#endif++#include <stdlib.h>+"; then :++else+  fptools_cv_htype_sup_unsigned_short=no+fi+++                if test "$HTYPE_IS_FLOAT" -eq 1+                then+                    fptools_cv_htype_unsigned_short=Float+                elif test "$HTYPE_IS_DOUBLE" -eq 1+                then+                    fptools_cv_htype_unsigned_short=Double+                elif test "$HTYPE_IS_LDOUBLE" -eq 1+                then+                    fptools_cv_htype_unsigned_short=LDouble+                else+                    fptools_cv_htype_sup_unsigned_short=no+                fi+            else+                if ac_fn_c_compute_int "$LINENO" "((unsigned short)(-1)) < ((unsigned short)0)" "HTYPE_IS_SIGNED"        "+#include <stdio.h>+#include <stddef.h>++#if HAVE_SYS_TYPES_H+# include <sys/types.h>+#endif++#if HAVE_UNISTD_H+# include <unistd.h>+#endif++#if HAVE_SYS_STAT_H+# include <sys/stat.h>+#endif++#if HAVE_FCNTL_H+# include <fcntl.h>+#endif++#if HAVE_SIGNAL_H+# include <signal.h>+#endif++#if HAVE_TIME_H+# include <time.h>+#endif++#if HAVE_TERMIOS_H+# include <termios.h>+#endif++#if HAVE_STRING_H+# include <string.h>+#endif++#if HAVE_CTYPE_H+# include <ctype.h>+#endif++#if HAVE_INTTYPES_H+# include <inttypes.h>+#else+# if HAVE_STDINT_H+#  include <stdint.h>+# endif+#endif++#if HAVE_SYS_RESOURCE_H+# include <sys/resource.h>+#endif++#include <stdlib.h>+"; then :++else+  fptools_cv_htype_sup_unsigned_short=no+fi+++                if ac_fn_c_compute_int "$LINENO" "sizeof(unsigned short) * 8" "HTYPE_SIZE"        "+#include <stdio.h>+#include <stddef.h>++#if HAVE_SYS_TYPES_H+# include <sys/types.h>+#endif++#if HAVE_UNISTD_H+# include <unistd.h>+#endif++#if HAVE_SYS_STAT_H+# include <sys/stat.h>+#endif++#if HAVE_FCNTL_H+# include <fcntl.h>+#endif++#if HAVE_SIGNAL_H+# include <signal.h>+#endif++#if HAVE_TIME_H+# include <time.h>+#endif++#if HAVE_TERMIOS_H+# include <termios.h>+#endif++#if HAVE_STRING_H+# include <string.h>+#endif++#if HAVE_CTYPE_H+# include <ctype.h>+#endif++#if HAVE_INTTYPES_H+# include <inttypes.h>+#else+# if HAVE_STDINT_H+#  include <stdint.h>+# endif+#endif++#if HAVE_SYS_RESOURCE_H+# include <sys/resource.h>+#endif++#include <stdlib.h>+"; then :++else+  fptools_cv_htype_sup_unsigned_short=no+fi+++                if test "$HTYPE_IS_SIGNED" -eq 0+                then+                    fptools_cv_htype_unsigned_short="Word$HTYPE_SIZE"+                else+                    fptools_cv_htype_unsigned_short="Int$HTYPE_SIZE"+                fi+            fi+        fi++fi++    if test "$fptools_cv_htype_sup_unsigned_short" = no+    then++        fptools_cv_htype_unsigned_short=NotReallyAType+        { $as_echo "$as_me:${as_lineno-$LINENO}: result: not supported" >&5+$as_echo "not supported" >&6; }++    fi++            if test "$fptools_cv_htype_sup_unsigned_short" = yes; then+        { $as_echo "$as_me:${as_lineno-$LINENO}: result: $fptools_cv_htype_unsigned_short" >&5+$as_echo "$fptools_cv_htype_unsigned_short" >&6; }++cat >>confdefs.h <<_ACEOF+#define HTYPE_UNSIGNED_SHORT $fptools_cv_htype_unsigned_short+_ACEOF++    fi+++++++++++    { $as_echo "$as_me:${as_lineno-$LINENO}: checking Haskell type for int" >&5+$as_echo_n "checking Haskell type for int... " >&6; }+    if test "${fptools_cv_htype_int+set}" = set; then :+  $as_echo_n "(cached) " >&6+else++        fptools_cv_htype_sup_int=yes+        if ac_fn_c_compute_int "$LINENO" "((int)((int)((int)1.4))) == ((int)1.4)" "HTYPE_IS_INTEGRAL"        "+#include <stdio.h>+#include <stddef.h>++#if HAVE_SYS_TYPES_H+# include <sys/types.h>+#endif++#if HAVE_UNISTD_H+# include <unistd.h>+#endif++#if HAVE_SYS_STAT_H+# include <sys/stat.h>+#endif++#if HAVE_FCNTL_H+# include <fcntl.h>+#endif++#if HAVE_SIGNAL_H+# include <signal.h>+#endif++#if HAVE_TIME_H+# include <time.h>+#endif++#if HAVE_TERMIOS_H+# include <termios.h>+#endif++#if HAVE_STRING_H+# include <string.h>+#endif++#if HAVE_CTYPE_H+# include <ctype.h>+#endif++#if HAVE_INTTYPES_H+# include <inttypes.h>+#else+# if HAVE_STDINT_H+#  include <stdint.h>+# endif+#endif++#if HAVE_SYS_RESOURCE_H+# include <sys/resource.h>+#endif++#include <stdlib.h>+"; then :++else+  fptools_cv_htype_sup_int=no+fi+++        if test "$fptools_cv_htype_sup_int" = "yes"+        then+            if test "$HTYPE_IS_INTEGRAL" -eq 0+            then+                if ac_fn_c_compute_int "$LINENO" "sizeof(int) == sizeof(float)" "HTYPE_IS_FLOAT"        "+#include <stdio.h>+#include <stddef.h>++#if HAVE_SYS_TYPES_H+# include <sys/types.h>+#endif++#if HAVE_UNISTD_H+# include <unistd.h>+#endif++#if HAVE_SYS_STAT_H+# include <sys/stat.h>+#endif++#if HAVE_FCNTL_H+# include <fcntl.h>+#endif++#if HAVE_SIGNAL_H+# include <signal.h>+#endif++#if HAVE_TIME_H+# include <time.h>+#endif++#if HAVE_TERMIOS_H+# include <termios.h>+#endif++#if HAVE_STRING_H+# include <string.h>+#endif++#if HAVE_CTYPE_H+# include <ctype.h>+#endif++#if HAVE_INTTYPES_H+# include <inttypes.h>+#else+# if HAVE_STDINT_H+#  include <stdint.h>+# endif+#endif++#if HAVE_SYS_RESOURCE_H+# include <sys/resource.h>+#endif++#include <stdlib.h>+"; then :++else+  fptools_cv_htype_sup_int=no+fi+++                if ac_fn_c_compute_int "$LINENO" "sizeof(int) == sizeof(double)" "HTYPE_IS_DOUBLE"        "+#include <stdio.h>+#include <stddef.h>++#if HAVE_SYS_TYPES_H+# include <sys/types.h>+#endif++#if HAVE_UNISTD_H+# include <unistd.h>+#endif++#if HAVE_SYS_STAT_H+# include <sys/stat.h>+#endif++#if HAVE_FCNTL_H+# include <fcntl.h>+#endif++#if HAVE_SIGNAL_H+# include <signal.h>+#endif++#if HAVE_TIME_H+# include <time.h>+#endif++#if HAVE_TERMIOS_H+# include <termios.h>+#endif++#if HAVE_STRING_H+# include <string.h>+#endif++#if HAVE_CTYPE_H+# include <ctype.h>+#endif++#if HAVE_INTTYPES_H+# include <inttypes.h>+#else+# if HAVE_STDINT_H+#  include <stdint.h>+# endif+#endif++#if HAVE_SYS_RESOURCE_H+# include <sys/resource.h>+#endif++#include <stdlib.h>+"; then :++else+  fptools_cv_htype_sup_int=no+fi+++                if ac_fn_c_compute_int "$LINENO" "sizeof(int) == sizeof(long double)" "HTYPE_IS_LDOUBLE"        "+#include <stdio.h>+#include <stddef.h>++#if HAVE_SYS_TYPES_H+# include <sys/types.h>+#endif++#if HAVE_UNISTD_H+# include <unistd.h>+#endif++#if HAVE_SYS_STAT_H+# include <sys/stat.h>+#endif++#if HAVE_FCNTL_H+# include <fcntl.h>+#endif++#if HAVE_SIGNAL_H+# include <signal.h>+#endif++#if HAVE_TIME_H+# include <time.h>+#endif++#if HAVE_TERMIOS_H+# include <termios.h>+#endif++#if HAVE_STRING_H+# include <string.h>+#endif++#if HAVE_CTYPE_H+# include <ctype.h>+#endif++#if HAVE_INTTYPES_H+# include <inttypes.h>+#else+# if HAVE_STDINT_H+#  include <stdint.h>+# endif+#endif++#if HAVE_SYS_RESOURCE_H+# include <sys/resource.h>+#endif++#include <stdlib.h>+"; then :++else+  fptools_cv_htype_sup_int=no+fi+++                if test "$HTYPE_IS_FLOAT" -eq 1+                then+                    fptools_cv_htype_int=Float+                elif test "$HTYPE_IS_DOUBLE" -eq 1+                then+                    fptools_cv_htype_int=Double+                elif test "$HTYPE_IS_LDOUBLE" -eq 1+                then+                    fptools_cv_htype_int=LDouble+                else+                    fptools_cv_htype_sup_int=no+                fi+            else+                if ac_fn_c_compute_int "$LINENO" "((int)(-1)) < ((int)0)" "HTYPE_IS_SIGNED"        "+#include <stdio.h>+#include <stddef.h>++#if HAVE_SYS_TYPES_H+# include <sys/types.h>+#endif++#if HAVE_UNISTD_H+# include <unistd.h>+#endif++#if HAVE_SYS_STAT_H+# include <sys/stat.h>+#endif++#if HAVE_FCNTL_H+# include <fcntl.h>+#endif++#if HAVE_SIGNAL_H+# include <signal.h>+#endif++#if HAVE_TIME_H+# include <time.h>+#endif++#if HAVE_TERMIOS_H+# include <termios.h>+#endif++#if HAVE_STRING_H+# include <string.h>+#endif++#if HAVE_CTYPE_H+# include <ctype.h>+#endif++#if HAVE_INTTYPES_H+# include <inttypes.h>+#else+# if HAVE_STDINT_H+#  include <stdint.h>+# endif+#endif++#if HAVE_SYS_RESOURCE_H+# include <sys/resource.h>+#endif++#include <stdlib.h>+"; then :++else+  fptools_cv_htype_sup_int=no+fi+++                if ac_fn_c_compute_int "$LINENO" "sizeof(int) * 8" "HTYPE_SIZE"        "+#include <stdio.h>+#include <stddef.h>++#if HAVE_SYS_TYPES_H+# include <sys/types.h>+#endif++#if HAVE_UNISTD_H+# include <unistd.h>+#endif++#if HAVE_SYS_STAT_H+# include <sys/stat.h>+#endif++#if HAVE_FCNTL_H+# include <fcntl.h>+#endif++#if HAVE_SIGNAL_H+# include <signal.h>+#endif++#if HAVE_TIME_H+# include <time.h>+#endif++#if HAVE_TERMIOS_H+# include <termios.h>+#endif++#if HAVE_STRING_H+# include <string.h>+#endif++#if HAVE_CTYPE_H+# include <ctype.h>+#endif++#if HAVE_INTTYPES_H+# include <inttypes.h>+#else+# if HAVE_STDINT_H+#  include <stdint.h>+# endif+#endif++#if HAVE_SYS_RESOURCE_H+# include <sys/resource.h>+#endif++#include <stdlib.h>+"; then :++else+  fptools_cv_htype_sup_int=no+fi+++                if test "$HTYPE_IS_SIGNED" -eq 0+                then+                    fptools_cv_htype_int="Word$HTYPE_SIZE"+                else+                    fptools_cv_htype_int="Int$HTYPE_SIZE"+                fi+            fi+        fi++fi++    if test "$fptools_cv_htype_sup_int" = no+    then++        fptools_cv_htype_int=NotReallyAType+        { $as_echo "$as_me:${as_lineno-$LINENO}: result: not supported" >&5+$as_echo "not supported" >&6; }++    fi++            if test "$fptools_cv_htype_sup_int" = yes; then+        { $as_echo "$as_me:${as_lineno-$LINENO}: result: $fptools_cv_htype_int" >&5+$as_echo "$fptools_cv_htype_int" >&6; }++cat >>confdefs.h <<_ACEOF+#define HTYPE_INT $fptools_cv_htype_int+_ACEOF++    fi+++++++++++    { $as_echo "$as_me:${as_lineno-$LINENO}: checking Haskell type for unsigned int" >&5+$as_echo_n "checking Haskell type for unsigned int... " >&6; }+    if test "${fptools_cv_htype_unsigned_int+set}" = set; then :+  $as_echo_n "(cached) " >&6+else++        fptools_cv_htype_sup_unsigned_int=yes+        if ac_fn_c_compute_int "$LINENO" "((unsigned int)((int)((unsigned int)1.4))) == ((unsigned int)1.4)" "HTYPE_IS_INTEGRAL"        "+#include <stdio.h>+#include <stddef.h>++#if HAVE_SYS_TYPES_H+# include <sys/types.h>+#endif++#if HAVE_UNISTD_H+# include <unistd.h>+#endif++#if HAVE_SYS_STAT_H+# include <sys/stat.h>+#endif++#if HAVE_FCNTL_H+# include <fcntl.h>+#endif++#if HAVE_SIGNAL_H+# include <signal.h>+#endif++#if HAVE_TIME_H+# include <time.h>+#endif++#if HAVE_TERMIOS_H+# include <termios.h>+#endif++#if HAVE_STRING_H+# include <string.h>+#endif++#if HAVE_CTYPE_H+# include <ctype.h>+#endif++#if HAVE_INTTYPES_H+# include <inttypes.h>+#else+# if HAVE_STDINT_H+#  include <stdint.h>+# endif+#endif++#if HAVE_SYS_RESOURCE_H+# include <sys/resource.h>+#endif++#include <stdlib.h>+"; then :++else+  fptools_cv_htype_sup_unsigned_int=no+fi+++        if test "$fptools_cv_htype_sup_unsigned_int" = "yes"+        then+            if test "$HTYPE_IS_INTEGRAL" -eq 0+            then+                if ac_fn_c_compute_int "$LINENO" "sizeof(unsigned int) == sizeof(float)" "HTYPE_IS_FLOAT"        "+#include <stdio.h>+#include <stddef.h>++#if HAVE_SYS_TYPES_H+# include <sys/types.h>+#endif++#if HAVE_UNISTD_H+# include <unistd.h>+#endif++#if HAVE_SYS_STAT_H+# include <sys/stat.h>+#endif++#if HAVE_FCNTL_H+# include <fcntl.h>+#endif++#if HAVE_SIGNAL_H+# include <signal.h>+#endif++#if HAVE_TIME_H+# include <time.h>+#endif++#if HAVE_TERMIOS_H+# include <termios.h>+#endif++#if HAVE_STRING_H+# include <string.h>+#endif++#if HAVE_CTYPE_H+# include <ctype.h>+#endif++#if HAVE_INTTYPES_H+# include <inttypes.h>+#else+# if HAVE_STDINT_H+#  include <stdint.h>+# endif+#endif++#if HAVE_SYS_RESOURCE_H+# include <sys/resource.h>+#endif++#include <stdlib.h>+"; then :++else+  fptools_cv_htype_sup_unsigned_int=no+fi+++                if ac_fn_c_compute_int "$LINENO" "sizeof(unsigned int) == sizeof(double)" "HTYPE_IS_DOUBLE"        "+#include <stdio.h>+#include <stddef.h>++#if HAVE_SYS_TYPES_H+# include <sys/types.h>+#endif++#if HAVE_UNISTD_H+# include <unistd.h>+#endif++#if HAVE_SYS_STAT_H+# include <sys/stat.h>+#endif++#if HAVE_FCNTL_H+# include <fcntl.h>+#endif++#if HAVE_SIGNAL_H+# include <signal.h>+#endif++#if HAVE_TIME_H+# include <time.h>+#endif++#if HAVE_TERMIOS_H+# include <termios.h>+#endif++#if HAVE_STRING_H+# include <string.h>+#endif++#if HAVE_CTYPE_H+# include <ctype.h>+#endif++#if HAVE_INTTYPES_H+# include <inttypes.h>+#else+# if HAVE_STDINT_H+#  include <stdint.h>+# endif+#endif++#if HAVE_SYS_RESOURCE_H+# include <sys/resource.h>+#endif++#include <stdlib.h>+"; then :++else+  fptools_cv_htype_sup_unsigned_int=no+fi+++                if ac_fn_c_compute_int "$LINENO" "sizeof(unsigned int) == sizeof(long double)" "HTYPE_IS_LDOUBLE"        "+#include <stdio.h>+#include <stddef.h>++#if HAVE_SYS_TYPES_H+# include <sys/types.h>+#endif++#if HAVE_UNISTD_H+# include <unistd.h>+#endif++#if HAVE_SYS_STAT_H+# include <sys/stat.h>+#endif++#if HAVE_FCNTL_H+# include <fcntl.h>+#endif++#if HAVE_SIGNAL_H+# include <signal.h>+#endif++#if HAVE_TIME_H+# include <time.h>+#endif++#if HAVE_TERMIOS_H+# include <termios.h>+#endif++#if HAVE_STRING_H+# include <string.h>+#endif++#if HAVE_CTYPE_H+# include <ctype.h>+#endif++#if HAVE_INTTYPES_H+# include <inttypes.h>+#else+# if HAVE_STDINT_H+#  include <stdint.h>+# endif+#endif++#if HAVE_SYS_RESOURCE_H+# include <sys/resource.h>+#endif++#include <stdlib.h>+"; then :++else+  fptools_cv_htype_sup_unsigned_int=no+fi+++                if test "$HTYPE_IS_FLOAT" -eq 1+                then+                    fptools_cv_htype_unsigned_int=Float+                elif test "$HTYPE_IS_DOUBLE" -eq 1+                then+                    fptools_cv_htype_unsigned_int=Double+                elif test "$HTYPE_IS_LDOUBLE" -eq 1+                then+                    fptools_cv_htype_unsigned_int=LDouble+                else+                    fptools_cv_htype_sup_unsigned_int=no+                fi+            else+                if ac_fn_c_compute_int "$LINENO" "((unsigned int)(-1)) < ((unsigned int)0)" "HTYPE_IS_SIGNED"        "+#include <stdio.h>+#include <stddef.h>++#if HAVE_SYS_TYPES_H+# include <sys/types.h>+#endif++#if HAVE_UNISTD_H+# include <unistd.h>+#endif++#if HAVE_SYS_STAT_H+# include <sys/stat.h>+#endif++#if HAVE_FCNTL_H+# include <fcntl.h>+#endif++#if HAVE_SIGNAL_H+# include <signal.h>+#endif++#if HAVE_TIME_H+# include <time.h>+#endif++#if HAVE_TERMIOS_H+# include <termios.h>+#endif++#if HAVE_STRING_H+# include <string.h>+#endif++#if HAVE_CTYPE_H+# include <ctype.h>+#endif++#if HAVE_INTTYPES_H+# include <inttypes.h>+#else+# if HAVE_STDINT_H+#  include <stdint.h>+# endif+#endif++#if HAVE_SYS_RESOURCE_H+# include <sys/resource.h>+#endif++#include <stdlib.h>+"; then :++else+  fptools_cv_htype_sup_unsigned_int=no+fi+++                if ac_fn_c_compute_int "$LINENO" "sizeof(unsigned int) * 8" "HTYPE_SIZE"        "+#include <stdio.h>+#include <stddef.h>++#if HAVE_SYS_TYPES_H+# include <sys/types.h>+#endif++#if HAVE_UNISTD_H+# include <unistd.h>+#endif++#if HAVE_SYS_STAT_H+# include <sys/stat.h>+#endif++#if HAVE_FCNTL_H+# include <fcntl.h>+#endif++#if HAVE_SIGNAL_H+# include <signal.h>+#endif++#if HAVE_TIME_H+# include <time.h>+#endif++#if HAVE_TERMIOS_H+# include <termios.h>+#endif++#if HAVE_STRING_H+# include <string.h>+#endif++#if HAVE_CTYPE_H+# include <ctype.h>+#endif++#if HAVE_INTTYPES_H+# include <inttypes.h>+#else+# if HAVE_STDINT_H+#  include <stdint.h>+# endif+#endif++#if HAVE_SYS_RESOURCE_H+# include <sys/resource.h>+#endif++#include <stdlib.h>+"; then :++else+  fptools_cv_htype_sup_unsigned_int=no+fi+++                if test "$HTYPE_IS_SIGNED" -eq 0+                then+                    fptools_cv_htype_unsigned_int="Word$HTYPE_SIZE"+                else+                    fptools_cv_htype_unsigned_int="Int$HTYPE_SIZE"+                fi+            fi+        fi++fi++    if test "$fptools_cv_htype_sup_unsigned_int" = no+    then++        fptools_cv_htype_unsigned_int=NotReallyAType+        { $as_echo "$as_me:${as_lineno-$LINENO}: result: not supported" >&5+$as_echo "not supported" >&6; }++    fi++            if test "$fptools_cv_htype_sup_unsigned_int" = yes; then+        { $as_echo "$as_me:${as_lineno-$LINENO}: result: $fptools_cv_htype_unsigned_int" >&5+$as_echo "$fptools_cv_htype_unsigned_int" >&6; }++cat >>confdefs.h <<_ACEOF+#define HTYPE_UNSIGNED_INT $fptools_cv_htype_unsigned_int+_ACEOF++    fi+++++++++++    { $as_echo "$as_me:${as_lineno-$LINENO}: checking Haskell type for long" >&5+$as_echo_n "checking Haskell type for long... " >&6; }+    if test "${fptools_cv_htype_long+set}" = set; then :+  $as_echo_n "(cached) " >&6+else++        fptools_cv_htype_sup_long=yes+        if ac_fn_c_compute_int "$LINENO" "((long)((int)((long)1.4))) == ((long)1.4)" "HTYPE_IS_INTEGRAL"        "+#include <stdio.h>+#include <stddef.h>++#if HAVE_SYS_TYPES_H+# include <sys/types.h>+#endif++#if HAVE_UNISTD_H+# include <unistd.h>+#endif++#if HAVE_SYS_STAT_H+# include <sys/stat.h>+#endif++#if HAVE_FCNTL_H+# include <fcntl.h>+#endif++#if HAVE_SIGNAL_H+# include <signal.h>+#endif++#if HAVE_TIME_H+# include <time.h>+#endif++#if HAVE_TERMIOS_H+# include <termios.h>+#endif++#if HAVE_STRING_H+# include <string.h>+#endif++#if HAVE_CTYPE_H+# include <ctype.h>+#endif++#if HAVE_INTTYPES_H+# include <inttypes.h>+#else+# if HAVE_STDINT_H+#  include <stdint.h>+# endif+#endif++#if HAVE_SYS_RESOURCE_H+# include <sys/resource.h>+#endif++#include <stdlib.h>+"; then :++else+  fptools_cv_htype_sup_long=no+fi+++        if test "$fptools_cv_htype_sup_long" = "yes"+        then+            if test "$HTYPE_IS_INTEGRAL" -eq 0+            then+                if ac_fn_c_compute_int "$LINENO" "sizeof(long) == sizeof(float)" "HTYPE_IS_FLOAT"        "+#include <stdio.h>+#include <stddef.h>++#if HAVE_SYS_TYPES_H+# include <sys/types.h>+#endif++#if HAVE_UNISTD_H+# include <unistd.h>+#endif++#if HAVE_SYS_STAT_H+# include <sys/stat.h>+#endif++#if HAVE_FCNTL_H+# include <fcntl.h>+#endif++#if HAVE_SIGNAL_H+# include <signal.h>+#endif++#if HAVE_TIME_H+# include <time.h>+#endif++#if HAVE_TERMIOS_H+# include <termios.h>+#endif++#if HAVE_STRING_H+# include <string.h>+#endif++#if HAVE_CTYPE_H+# include <ctype.h>+#endif++#if HAVE_INTTYPES_H+# include <inttypes.h>+#else+# if HAVE_STDINT_H+#  include <stdint.h>+# endif+#endif++#if HAVE_SYS_RESOURCE_H+# include <sys/resource.h>+#endif++#include <stdlib.h>+"; then :++else+  fptools_cv_htype_sup_long=no+fi+++                if ac_fn_c_compute_int "$LINENO" "sizeof(long) == sizeof(double)" "HTYPE_IS_DOUBLE"        "+#include <stdio.h>+#include <stddef.h>++#if HAVE_SYS_TYPES_H+# include <sys/types.h>+#endif++#if HAVE_UNISTD_H+# include <unistd.h>+#endif++#if HAVE_SYS_STAT_H+# include <sys/stat.h>+#endif++#if HAVE_FCNTL_H+# include <fcntl.h>+#endif++#if HAVE_SIGNAL_H+# include <signal.h>+#endif++#if HAVE_TIME_H+# include <time.h>+#endif++#if HAVE_TERMIOS_H+# include <termios.h>+#endif++#if HAVE_STRING_H+# include <string.h>+#endif++#if HAVE_CTYPE_H+# include <ctype.h>+#endif++#if HAVE_INTTYPES_H+# include <inttypes.h>+#else+# if HAVE_STDINT_H+#  include <stdint.h>+# endif+#endif++#if HAVE_SYS_RESOURCE_H+# include <sys/resource.h>+#endif++#include <stdlib.h>+"; then :++else+  fptools_cv_htype_sup_long=no+fi+++                if ac_fn_c_compute_int "$LINENO" "sizeof(long) == sizeof(long double)" "HTYPE_IS_LDOUBLE"        "+#include <stdio.h>+#include <stddef.h>++#if HAVE_SYS_TYPES_H+# include <sys/types.h>+#endif++#if HAVE_UNISTD_H+# include <unistd.h>+#endif++#if HAVE_SYS_STAT_H+# include <sys/stat.h>+#endif++#if HAVE_FCNTL_H+# include <fcntl.h>+#endif++#if HAVE_SIGNAL_H+# include <signal.h>+#endif++#if HAVE_TIME_H+# include <time.h>+#endif++#if HAVE_TERMIOS_H+# include <termios.h>+#endif++#if HAVE_STRING_H+# include <string.h>+#endif++#if HAVE_CTYPE_H+# include <ctype.h>+#endif++#if HAVE_INTTYPES_H+# include <inttypes.h>+#else+# if HAVE_STDINT_H+#  include <stdint.h>+# endif+#endif++#if HAVE_SYS_RESOURCE_H+# include <sys/resource.h>+#endif++#include <stdlib.h>+"; then :++else+  fptools_cv_htype_sup_long=no+fi+++                if test "$HTYPE_IS_FLOAT" -eq 1+                then+                    fptools_cv_htype_long=Float+                elif test "$HTYPE_IS_DOUBLE" -eq 1+                then+                    fptools_cv_htype_long=Double+                elif test "$HTYPE_IS_LDOUBLE" -eq 1+                then+                    fptools_cv_htype_long=LDouble+                else+                    fptools_cv_htype_sup_long=no+                fi+            else+                if ac_fn_c_compute_int "$LINENO" "((long)(-1)) < ((long)0)" "HTYPE_IS_SIGNED"        "+#include <stdio.h>+#include <stddef.h>++#if HAVE_SYS_TYPES_H+# include <sys/types.h>+#endif++#if HAVE_UNISTD_H+# include <unistd.h>+#endif++#if HAVE_SYS_STAT_H+# include <sys/stat.h>+#endif++#if HAVE_FCNTL_H+# include <fcntl.h>+#endif++#if HAVE_SIGNAL_H+# include <signal.h>+#endif++#if HAVE_TIME_H+# include <time.h>+#endif++#if HAVE_TERMIOS_H+# include <termios.h>+#endif++#if HAVE_STRING_H+# include <string.h>+#endif++#if HAVE_CTYPE_H+# include <ctype.h>+#endif++#if HAVE_INTTYPES_H+# include <inttypes.h>+#else+# if HAVE_STDINT_H+#  include <stdint.h>+# endif+#endif++#if HAVE_SYS_RESOURCE_H+# include <sys/resource.h>+#endif++#include <stdlib.h>+"; then :++else+  fptools_cv_htype_sup_long=no+fi+++                if ac_fn_c_compute_int "$LINENO" "sizeof(long) * 8" "HTYPE_SIZE"        "+#include <stdio.h>+#include <stddef.h>++#if HAVE_SYS_TYPES_H+# include <sys/types.h>+#endif++#if HAVE_UNISTD_H+# include <unistd.h>+#endif++#if HAVE_SYS_STAT_H+# include <sys/stat.h>+#endif++#if HAVE_FCNTL_H+# include <fcntl.h>+#endif++#if HAVE_SIGNAL_H+# include <signal.h>+#endif++#if HAVE_TIME_H+# include <time.h>+#endif++#if HAVE_TERMIOS_H+# include <termios.h>+#endif++#if HAVE_STRING_H+# include <string.h>+#endif++#if HAVE_CTYPE_H+# include <ctype.h>+#endif++#if HAVE_INTTYPES_H+# include <inttypes.h>+#else+# if HAVE_STDINT_H+#  include <stdint.h>+# endif+#endif++#if HAVE_SYS_RESOURCE_H+# include <sys/resource.h>+#endif++#include <stdlib.h>+"; then :++else+  fptools_cv_htype_sup_long=no+fi+++                if test "$HTYPE_IS_SIGNED" -eq 0+                then+                    fptools_cv_htype_long="Word$HTYPE_SIZE"+                else+                    fptools_cv_htype_long="Int$HTYPE_SIZE"+                fi+            fi+        fi++fi++    if test "$fptools_cv_htype_sup_long" = no+    then++        fptools_cv_htype_long=NotReallyAType+        { $as_echo "$as_me:${as_lineno-$LINENO}: result: not supported" >&5+$as_echo "not supported" >&6; }++    fi++            if test "$fptools_cv_htype_sup_long" = yes; then+        { $as_echo "$as_me:${as_lineno-$LINENO}: result: $fptools_cv_htype_long" >&5+$as_echo "$fptools_cv_htype_long" >&6; }++cat >>confdefs.h <<_ACEOF+#define HTYPE_LONG $fptools_cv_htype_long+_ACEOF++    fi+++++++++++    { $as_echo "$as_me:${as_lineno-$LINENO}: checking Haskell type for unsigned long" >&5+$as_echo_n "checking Haskell type for unsigned long... " >&6; }+    if test "${fptools_cv_htype_unsigned_long+set}" = set; then :+  $as_echo_n "(cached) " >&6+else++        fptools_cv_htype_sup_unsigned_long=yes+        if ac_fn_c_compute_int "$LINENO" "((unsigned long)((int)((unsigned long)1.4))) == ((unsigned long)1.4)" "HTYPE_IS_INTEGRAL"        "+#include <stdio.h>+#include <stddef.h>++#if HAVE_SYS_TYPES_H+# include <sys/types.h>+#endif++#if HAVE_UNISTD_H+# include <unistd.h>+#endif++#if HAVE_SYS_STAT_H+# include <sys/stat.h>+#endif++#if HAVE_FCNTL_H+# include <fcntl.h>+#endif++#if HAVE_SIGNAL_H+# include <signal.h>+#endif++#if HAVE_TIME_H+# include <time.h>+#endif++#if HAVE_TERMIOS_H+# include <termios.h>+#endif++#if HAVE_STRING_H+# include <string.h>+#endif++#if HAVE_CTYPE_H+# include <ctype.h>+#endif++#if HAVE_INTTYPES_H+# include <inttypes.h>+#else+# if HAVE_STDINT_H+#  include <stdint.h>+# endif+#endif++#if HAVE_SYS_RESOURCE_H+# include <sys/resource.h>+#endif++#include <stdlib.h>+"; then :++else+  fptools_cv_htype_sup_unsigned_long=no+fi+++        if test "$fptools_cv_htype_sup_unsigned_long" = "yes"+        then+            if test "$HTYPE_IS_INTEGRAL" -eq 0+            then+                if ac_fn_c_compute_int "$LINENO" "sizeof(unsigned long) == sizeof(float)" "HTYPE_IS_FLOAT"        "+#include <stdio.h>+#include <stddef.h>++#if HAVE_SYS_TYPES_H+# include <sys/types.h>+#endif++#if HAVE_UNISTD_H+# include <unistd.h>+#endif++#if HAVE_SYS_STAT_H+# include <sys/stat.h>+#endif++#if HAVE_FCNTL_H+# include <fcntl.h>+#endif++#if HAVE_SIGNAL_H+# include <signal.h>+#endif++#if HAVE_TIME_H+# include <time.h>+#endif++#if HAVE_TERMIOS_H+# include <termios.h>+#endif++#if HAVE_STRING_H+# include <string.h>+#endif++#if HAVE_CTYPE_H+# include <ctype.h>+#endif++#if HAVE_INTTYPES_H+# include <inttypes.h>+#else+# if HAVE_STDINT_H+#  include <stdint.h>+# endif+#endif++#if HAVE_SYS_RESOURCE_H+# include <sys/resource.h>+#endif++#include <stdlib.h>+"; then :++else+  fptools_cv_htype_sup_unsigned_long=no+fi+++                if ac_fn_c_compute_int "$LINENO" "sizeof(unsigned long) == sizeof(double)" "HTYPE_IS_DOUBLE"        "+#include <stdio.h>+#include <stddef.h>++#if HAVE_SYS_TYPES_H+# include <sys/types.h>+#endif++#if HAVE_UNISTD_H+# include <unistd.h>+#endif++#if HAVE_SYS_STAT_H+# include <sys/stat.h>+#endif++#if HAVE_FCNTL_H+# include <fcntl.h>+#endif++#if HAVE_SIGNAL_H+# include <signal.h>+#endif++#if HAVE_TIME_H+# include <time.h>+#endif++#if HAVE_TERMIOS_H+# include <termios.h>+#endif++#if HAVE_STRING_H+# include <string.h>+#endif++#if HAVE_CTYPE_H+# include <ctype.h>+#endif++#if HAVE_INTTYPES_H+# include <inttypes.h>+#else+# if HAVE_STDINT_H+#  include <stdint.h>+# endif+#endif++#if HAVE_SYS_RESOURCE_H+# include <sys/resource.h>+#endif++#include <stdlib.h>+"; then :++else+  fptools_cv_htype_sup_unsigned_long=no+fi+++                if ac_fn_c_compute_int "$LINENO" "sizeof(unsigned long) == sizeof(long double)" "HTYPE_IS_LDOUBLE"        "+#include <stdio.h>+#include <stddef.h>++#if HAVE_SYS_TYPES_H+# include <sys/types.h>+#endif++#if HAVE_UNISTD_H+# include <unistd.h>+#endif++#if HAVE_SYS_STAT_H+# include <sys/stat.h>+#endif++#if HAVE_FCNTL_H+# include <fcntl.h>+#endif++#if HAVE_SIGNAL_H+# include <signal.h>+#endif++#if HAVE_TIME_H+# include <time.h>+#endif++#if HAVE_TERMIOS_H+# include <termios.h>+#endif++#if HAVE_STRING_H+# include <string.h>+#endif++#if HAVE_CTYPE_H+# include <ctype.h>+#endif++#if HAVE_INTTYPES_H+# include <inttypes.h>+#else+# if HAVE_STDINT_H+#  include <stdint.h>+# endif+#endif++#if HAVE_SYS_RESOURCE_H+# include <sys/resource.h>+#endif++#include <stdlib.h>+"; then :++else+  fptools_cv_htype_sup_unsigned_long=no+fi+++                if test "$HTYPE_IS_FLOAT" -eq 1+                then+                    fptools_cv_htype_unsigned_long=Float+                elif test "$HTYPE_IS_DOUBLE" -eq 1+                then+                    fptools_cv_htype_unsigned_long=Double+                elif test "$HTYPE_IS_LDOUBLE" -eq 1+                then+                    fptools_cv_htype_unsigned_long=LDouble+                else+                    fptools_cv_htype_sup_unsigned_long=no+                fi+            else+                if ac_fn_c_compute_int "$LINENO" "((unsigned long)(-1)) < ((unsigned long)0)" "HTYPE_IS_SIGNED"        "+#include <stdio.h>+#include <stddef.h>++#if HAVE_SYS_TYPES_H+# include <sys/types.h>+#endif++#if HAVE_UNISTD_H+# include <unistd.h>+#endif++#if HAVE_SYS_STAT_H+# include <sys/stat.h>+#endif++#if HAVE_FCNTL_H+# include <fcntl.h>+#endif++#if HAVE_SIGNAL_H+# include <signal.h>+#endif++#if HAVE_TIME_H+# include <time.h>+#endif++#if HAVE_TERMIOS_H+# include <termios.h>+#endif++#if HAVE_STRING_H+# include <string.h>+#endif++#if HAVE_CTYPE_H+# include <ctype.h>+#endif++#if HAVE_INTTYPES_H+# include <inttypes.h>+#else+# if HAVE_STDINT_H+#  include <stdint.h>+# endif+#endif++#if HAVE_SYS_RESOURCE_H+# include <sys/resource.h>+#endif++#include <stdlib.h>+"; then :++else+  fptools_cv_htype_sup_unsigned_long=no+fi+++                if ac_fn_c_compute_int "$LINENO" "sizeof(unsigned long) * 8" "HTYPE_SIZE"        "+#include <stdio.h>+#include <stddef.h>++#if HAVE_SYS_TYPES_H+# include <sys/types.h>+#endif++#if HAVE_UNISTD_H+# include <unistd.h>+#endif++#if HAVE_SYS_STAT_H+# include <sys/stat.h>+#endif++#if HAVE_FCNTL_H+# include <fcntl.h>+#endif++#if HAVE_SIGNAL_H+# include <signal.h>+#endif++#if HAVE_TIME_H+# include <time.h>+#endif++#if HAVE_TERMIOS_H+# include <termios.h>+#endif++#if HAVE_STRING_H+# include <string.h>+#endif++#if HAVE_CTYPE_H+# include <ctype.h>+#endif++#if HAVE_INTTYPES_H+# include <inttypes.h>+#else+# if HAVE_STDINT_H+#  include <stdint.h>+# endif+#endif++#if HAVE_SYS_RESOURCE_H+# include <sys/resource.h>+#endif++#include <stdlib.h>+"; then :++else+  fptools_cv_htype_sup_unsigned_long=no+fi+++                if test "$HTYPE_IS_SIGNED" -eq 0+                then+                    fptools_cv_htype_unsigned_long="Word$HTYPE_SIZE"+                else+                    fptools_cv_htype_unsigned_long="Int$HTYPE_SIZE"+                fi+            fi+        fi++fi++    if test "$fptools_cv_htype_sup_unsigned_long" = no+    then++        fptools_cv_htype_unsigned_long=NotReallyAType+        { $as_echo "$as_me:${as_lineno-$LINENO}: result: not supported" >&5+$as_echo "not supported" >&6; }++    fi++            if test "$fptools_cv_htype_sup_unsigned_long" = yes; then+        { $as_echo "$as_me:${as_lineno-$LINENO}: result: $fptools_cv_htype_unsigned_long" >&5+$as_echo "$fptools_cv_htype_unsigned_long" >&6; }++cat >>confdefs.h <<_ACEOF+#define HTYPE_UNSIGNED_LONG $fptools_cv_htype_unsigned_long+_ACEOF++    fi+++if test "$ac_cv_type_long_long" = yes; then+++++++++    { $as_echo "$as_me:${as_lineno-$LINENO}: checking Haskell type for long long" >&5+$as_echo_n "checking Haskell type for long long... " >&6; }+    if test "${fptools_cv_htype_long_long+set}" = set; then :+  $as_echo_n "(cached) " >&6+else++        fptools_cv_htype_sup_long_long=yes+        if ac_fn_c_compute_int "$LINENO" "((long long)((int)((long long)1.4))) == ((long long)1.4)" "HTYPE_IS_INTEGRAL"        "+#include <stdio.h>+#include <stddef.h>++#if HAVE_SYS_TYPES_H+# include <sys/types.h>+#endif++#if HAVE_UNISTD_H+# include <unistd.h>+#endif++#if HAVE_SYS_STAT_H+# include <sys/stat.h>+#endif++#if HAVE_FCNTL_H+# include <fcntl.h>+#endif++#if HAVE_SIGNAL_H+# include <signal.h>+#endif++#if HAVE_TIME_H+# include <time.h>+#endif++#if HAVE_TERMIOS_H+# include <termios.h>+#endif++#if HAVE_STRING_H+# include <string.h>+#endif++#if HAVE_CTYPE_H+# include <ctype.h>+#endif++#if HAVE_INTTYPES_H+# include <inttypes.h>+#else+# if HAVE_STDINT_H+#  include <stdint.h>+# endif+#endif++#if HAVE_SYS_RESOURCE_H+# include <sys/resource.h>+#endif++#include <stdlib.h>+"; then :++else+  fptools_cv_htype_sup_long_long=no+fi+++        if test "$fptools_cv_htype_sup_long_long" = "yes"+        then+            if test "$HTYPE_IS_INTEGRAL" -eq 0+            then+                if ac_fn_c_compute_int "$LINENO" "sizeof(long long) == sizeof(float)" "HTYPE_IS_FLOAT"        "+#include <stdio.h>+#include <stddef.h>++#if HAVE_SYS_TYPES_H+# include <sys/types.h>+#endif++#if HAVE_UNISTD_H+# include <unistd.h>+#endif++#if HAVE_SYS_STAT_H+# include <sys/stat.h>+#endif++#if HAVE_FCNTL_H+# include <fcntl.h>+#endif++#if HAVE_SIGNAL_H+# include <signal.h>+#endif++#if HAVE_TIME_H+# include <time.h>+#endif++#if HAVE_TERMIOS_H+# include <termios.h>+#endif++#if HAVE_STRING_H+# include <string.h>+#endif++#if HAVE_CTYPE_H+# include <ctype.h>+#endif++#if HAVE_INTTYPES_H+# include <inttypes.h>+#else+# if HAVE_STDINT_H+#  include <stdint.h>+# endif+#endif++#if HAVE_SYS_RESOURCE_H+# include <sys/resource.h>+#endif++#include <stdlib.h>+"; then :++else+  fptools_cv_htype_sup_long_long=no+fi+++                if ac_fn_c_compute_int "$LINENO" "sizeof(long long) == sizeof(double)" "HTYPE_IS_DOUBLE"        "+#include <stdio.h>+#include <stddef.h>++#if HAVE_SYS_TYPES_H+# include <sys/types.h>+#endif++#if HAVE_UNISTD_H+# include <unistd.h>+#endif++#if HAVE_SYS_STAT_H+# include <sys/stat.h>+#endif++#if HAVE_FCNTL_H+# include <fcntl.h>+#endif++#if HAVE_SIGNAL_H+# include <signal.h>+#endif++#if HAVE_TIME_H+# include <time.h>+#endif++#if HAVE_TERMIOS_H+# include <termios.h>+#endif++#if HAVE_STRING_H+# include <string.h>+#endif++#if HAVE_CTYPE_H+# include <ctype.h>+#endif++#if HAVE_INTTYPES_H+# include <inttypes.h>+#else+# if HAVE_STDINT_H+#  include <stdint.h>+# endif+#endif++#if HAVE_SYS_RESOURCE_H+# include <sys/resource.h>+#endif++#include <stdlib.h>+"; then :++else+  fptools_cv_htype_sup_long_long=no+fi+++                if ac_fn_c_compute_int "$LINENO" "sizeof(long long) == sizeof(long double)" "HTYPE_IS_LDOUBLE"        "+#include <stdio.h>+#include <stddef.h>++#if HAVE_SYS_TYPES_H+# include <sys/types.h>+#endif++#if HAVE_UNISTD_H+# include <unistd.h>+#endif++#if HAVE_SYS_STAT_H+# include <sys/stat.h>+#endif++#if HAVE_FCNTL_H+# include <fcntl.h>+#endif++#if HAVE_SIGNAL_H+# include <signal.h>+#endif++#if HAVE_TIME_H+# include <time.h>+#endif++#if HAVE_TERMIOS_H+# include <termios.h>+#endif++#if HAVE_STRING_H+# include <string.h>+#endif++#if HAVE_CTYPE_H+# include <ctype.h>+#endif++#if HAVE_INTTYPES_H+# include <inttypes.h>+#else+# if HAVE_STDINT_H+#  include <stdint.h>+# endif+#endif++#if HAVE_SYS_RESOURCE_H+# include <sys/resource.h>+#endif++#include <stdlib.h>+"; then :++else+  fptools_cv_htype_sup_long_long=no+fi+++                if test "$HTYPE_IS_FLOAT" -eq 1+                then+                    fptools_cv_htype_long_long=Float+                elif test "$HTYPE_IS_DOUBLE" -eq 1+                then+                    fptools_cv_htype_long_long=Double+                elif test "$HTYPE_IS_LDOUBLE" -eq 1+                then+                    fptools_cv_htype_long_long=LDouble+                else+                    fptools_cv_htype_sup_long_long=no+                fi+            else+                if ac_fn_c_compute_int "$LINENO" "((long long)(-1)) < ((long long)0)" "HTYPE_IS_SIGNED"        "+#include <stdio.h>+#include <stddef.h>++#if HAVE_SYS_TYPES_H+# include <sys/types.h>+#endif++#if HAVE_UNISTD_H+# include <unistd.h>+#endif++#if HAVE_SYS_STAT_H+# include <sys/stat.h>+#endif++#if HAVE_FCNTL_H+# include <fcntl.h>+#endif++#if HAVE_SIGNAL_H+# include <signal.h>+#endif++#if HAVE_TIME_H+# include <time.h>+#endif++#if HAVE_TERMIOS_H+# include <termios.h>+#endif++#if HAVE_STRING_H+# include <string.h>+#endif++#if HAVE_CTYPE_H+# include <ctype.h>+#endif++#if HAVE_INTTYPES_H+# include <inttypes.h>+#else+# if HAVE_STDINT_H+#  include <stdint.h>+# endif+#endif++#if HAVE_SYS_RESOURCE_H+# include <sys/resource.h>+#endif++#include <stdlib.h>+"; then :++else+  fptools_cv_htype_sup_long_long=no+fi+++                if ac_fn_c_compute_int "$LINENO" "sizeof(long long) * 8" "HTYPE_SIZE"        "+#include <stdio.h>+#include <stddef.h>++#if HAVE_SYS_TYPES_H+# include <sys/types.h>+#endif++#if HAVE_UNISTD_H+# include <unistd.h>+#endif++#if HAVE_SYS_STAT_H+# include <sys/stat.h>+#endif++#if HAVE_FCNTL_H+# include <fcntl.h>+#endif++#if HAVE_SIGNAL_H+# include <signal.h>+#endif++#if HAVE_TIME_H+# include <time.h>+#endif++#if HAVE_TERMIOS_H+# include <termios.h>+#endif++#if HAVE_STRING_H+# include <string.h>+#endif++#if HAVE_CTYPE_H+# include <ctype.h>+#endif++#if HAVE_INTTYPES_H+# include <inttypes.h>+#else+# if HAVE_STDINT_H+#  include <stdint.h>+# endif+#endif++#if HAVE_SYS_RESOURCE_H+# include <sys/resource.h>+#endif++#include <stdlib.h>+"; then :++else+  fptools_cv_htype_sup_long_long=no+fi+++                if test "$HTYPE_IS_SIGNED" -eq 0+                then+                    fptools_cv_htype_long_long="Word$HTYPE_SIZE"+                else+                    fptools_cv_htype_long_long="Int$HTYPE_SIZE"+                fi+            fi+        fi++fi++    if test "$fptools_cv_htype_sup_long_long" = no+    then++        fptools_cv_htype_long_long=NotReallyAType+        { $as_echo "$as_me:${as_lineno-$LINENO}: result: not supported" >&5+$as_echo "not supported" >&6; }++    fi++            if test "$fptools_cv_htype_sup_long_long" = yes; then+        { $as_echo "$as_me:${as_lineno-$LINENO}: result: $fptools_cv_htype_long_long" >&5+$as_echo "$fptools_cv_htype_long_long" >&6; }++cat >>confdefs.h <<_ACEOF+#define HTYPE_LONG_LONG $fptools_cv_htype_long_long+_ACEOF++    fi+++++++++++    { $as_echo "$as_me:${as_lineno-$LINENO}: checking Haskell type for unsigned long long" >&5+$as_echo_n "checking Haskell type for unsigned long long... " >&6; }+    if test "${fptools_cv_htype_unsigned_long_long+set}" = set; then :+  $as_echo_n "(cached) " >&6+else++        fptools_cv_htype_sup_unsigned_long_long=yes+        if ac_fn_c_compute_int "$LINENO" "((unsigned long long)((int)((unsigned long long)1.4))) == ((unsigned long long)1.4)" "HTYPE_IS_INTEGRAL"        "+#include <stdio.h>+#include <stddef.h>++#if HAVE_SYS_TYPES_H+# include <sys/types.h>+#endif++#if HAVE_UNISTD_H+# include <unistd.h>+#endif++#if HAVE_SYS_STAT_H+# include <sys/stat.h>+#endif++#if HAVE_FCNTL_H+# include <fcntl.h>+#endif++#if HAVE_SIGNAL_H+# include <signal.h>+#endif++#if HAVE_TIME_H+# include <time.h>+#endif++#if HAVE_TERMIOS_H+# include <termios.h>+#endif++#if HAVE_STRING_H+# include <string.h>+#endif++#if HAVE_CTYPE_H+# include <ctype.h>+#endif++#if HAVE_INTTYPES_H+# include <inttypes.h>+#else+# if HAVE_STDINT_H+#  include <stdint.h>+# endif+#endif++#if HAVE_SYS_RESOURCE_H+# include <sys/resource.h>+#endif++#include <stdlib.h>+"; then :++else+  fptools_cv_htype_sup_unsigned_long_long=no+fi+++        if test "$fptools_cv_htype_sup_unsigned_long_long" = "yes"+        then+            if test "$HTYPE_IS_INTEGRAL" -eq 0+            then+                if ac_fn_c_compute_int "$LINENO" "sizeof(unsigned long long) == sizeof(float)" "HTYPE_IS_FLOAT"        "+#include <stdio.h>+#include <stddef.h>++#if HAVE_SYS_TYPES_H+# include <sys/types.h>+#endif++#if HAVE_UNISTD_H+# include <unistd.h>+#endif++#if HAVE_SYS_STAT_H+# include <sys/stat.h>+#endif++#if HAVE_FCNTL_H+# include <fcntl.h>+#endif++#if HAVE_SIGNAL_H+# include <signal.h>+#endif++#if HAVE_TIME_H+# include <time.h>+#endif++#if HAVE_TERMIOS_H+# include <termios.h>+#endif++#if HAVE_STRING_H+# include <string.h>+#endif++#if HAVE_CTYPE_H+# include <ctype.h>+#endif++#if HAVE_INTTYPES_H+# include <inttypes.h>+#else+# if HAVE_STDINT_H+#  include <stdint.h>+# endif+#endif++#if HAVE_SYS_RESOURCE_H+# include <sys/resource.h>+#endif++#include <stdlib.h>+"; then :++else+  fptools_cv_htype_sup_unsigned_long_long=no+fi+++                if ac_fn_c_compute_int "$LINENO" "sizeof(unsigned long long) == sizeof(double)" "HTYPE_IS_DOUBLE"        "+#include <stdio.h>+#include <stddef.h>++#if HAVE_SYS_TYPES_H+# include <sys/types.h>+#endif++#if HAVE_UNISTD_H+# include <unistd.h>+#endif++#if HAVE_SYS_STAT_H+# include <sys/stat.h>+#endif++#if HAVE_FCNTL_H+# include <fcntl.h>+#endif++#if HAVE_SIGNAL_H+# include <signal.h>+#endif++#if HAVE_TIME_H+# include <time.h>+#endif++#if HAVE_TERMIOS_H+# include <termios.h>+#endif++#if HAVE_STRING_H+# include <string.h>+#endif++#if HAVE_CTYPE_H+# include <ctype.h>+#endif++#if HAVE_INTTYPES_H+# include <inttypes.h>+#else+# if HAVE_STDINT_H+#  include <stdint.h>+# endif+#endif++#if HAVE_SYS_RESOURCE_H+# include <sys/resource.h>+#endif++#include <stdlib.h>+"; then :++else+  fptools_cv_htype_sup_unsigned_long_long=no+fi+++                if ac_fn_c_compute_int "$LINENO" "sizeof(unsigned long long) == sizeof(long double)" "HTYPE_IS_LDOUBLE"        "+#include <stdio.h>+#include <stddef.h>++#if HAVE_SYS_TYPES_H+# include <sys/types.h>+#endif++#if HAVE_UNISTD_H+# include <unistd.h>+#endif++#if HAVE_SYS_STAT_H+# include <sys/stat.h>+#endif++#if HAVE_FCNTL_H+# include <fcntl.h>+#endif++#if HAVE_SIGNAL_H+# include <signal.h>+#endif++#if HAVE_TIME_H+# include <time.h>+#endif++#if HAVE_TERMIOS_H+# include <termios.h>+#endif++#if HAVE_STRING_H+# include <string.h>+#endif++#if HAVE_CTYPE_H+# include <ctype.h>+#endif++#if HAVE_INTTYPES_H+# include <inttypes.h>+#else+# if HAVE_STDINT_H+#  include <stdint.h>+# endif+#endif++#if HAVE_SYS_RESOURCE_H+# include <sys/resource.h>+#endif++#include <stdlib.h>+"; then :++else+  fptools_cv_htype_sup_unsigned_long_long=no+fi+++                if test "$HTYPE_IS_FLOAT" -eq 1+                then+                    fptools_cv_htype_unsigned_long_long=Float+                elif test "$HTYPE_IS_DOUBLE" -eq 1+                then+                    fptools_cv_htype_unsigned_long_long=Double+                elif test "$HTYPE_IS_LDOUBLE" -eq 1+                then+                    fptools_cv_htype_unsigned_long_long=LDouble+                else+                    fptools_cv_htype_sup_unsigned_long_long=no+                fi+            else+                if ac_fn_c_compute_int "$LINENO" "((unsigned long long)(-1)) < ((unsigned long long)0)" "HTYPE_IS_SIGNED"        "+#include <stdio.h>+#include <stddef.h>++#if HAVE_SYS_TYPES_H+# include <sys/types.h>+#endif++#if HAVE_UNISTD_H+# include <unistd.h>+#endif++#if HAVE_SYS_STAT_H+# include <sys/stat.h>+#endif++#if HAVE_FCNTL_H+# include <fcntl.h>+#endif++#if HAVE_SIGNAL_H+# include <signal.h>+#endif++#if HAVE_TIME_H+# include <time.h>+#endif++#if HAVE_TERMIOS_H+# include <termios.h>+#endif++#if HAVE_STRING_H+# include <string.h>+#endif++#if HAVE_CTYPE_H+# include <ctype.h>+#endif++#if HAVE_INTTYPES_H+# include <inttypes.h>+#else+# if HAVE_STDINT_H+#  include <stdint.h>+# endif+#endif++#if HAVE_SYS_RESOURCE_H+# include <sys/resource.h>+#endif++#include <stdlib.h>+"; then :++else+  fptools_cv_htype_sup_unsigned_long_long=no+fi+++                if ac_fn_c_compute_int "$LINENO" "sizeof(unsigned long long) * 8" "HTYPE_SIZE"        "+#include <stdio.h>+#include <stddef.h>++#if HAVE_SYS_TYPES_H+# include <sys/types.h>+#endif++#if HAVE_UNISTD_H+# include <unistd.h>+#endif++#if HAVE_SYS_STAT_H+# include <sys/stat.h>+#endif++#if HAVE_FCNTL_H+# include <fcntl.h>+#endif++#if HAVE_SIGNAL_H+# include <signal.h>+#endif++#if HAVE_TIME_H+# include <time.h>+#endif++#if HAVE_TERMIOS_H+# include <termios.h>+#endif++#if HAVE_STRING_H+# include <string.h>+#endif++#if HAVE_CTYPE_H+# include <ctype.h>+#endif++#if HAVE_INTTYPES_H+# include <inttypes.h>+#else+# if HAVE_STDINT_H+#  include <stdint.h>+# endif+#endif++#if HAVE_SYS_RESOURCE_H+# include <sys/resource.h>+#endif++#include <stdlib.h>+"; then :++else+  fptools_cv_htype_sup_unsigned_long_long=no+fi+++                if test "$HTYPE_IS_SIGNED" -eq 0+                then+                    fptools_cv_htype_unsigned_long_long="Word$HTYPE_SIZE"+                else+                    fptools_cv_htype_unsigned_long_long="Int$HTYPE_SIZE"+                fi+            fi+        fi++fi++    if test "$fptools_cv_htype_sup_unsigned_long_long" = no+    then++        fptools_cv_htype_unsigned_long_long=NotReallyAType+        { $as_echo "$as_me:${as_lineno-$LINENO}: result: not supported" >&5+$as_echo "not supported" >&6; }++    fi++            if test "$fptools_cv_htype_sup_unsigned_long_long" = yes; then+        { $as_echo "$as_me:${as_lineno-$LINENO}: result: $fptools_cv_htype_unsigned_long_long" >&5+$as_echo "$fptools_cv_htype_unsigned_long_long" >&6; }++cat >>confdefs.h <<_ACEOF+#define HTYPE_UNSIGNED_LONG_LONG $fptools_cv_htype_unsigned_long_long+_ACEOF++    fi+++fi+++++++++    { $as_echo "$as_me:${as_lineno-$LINENO}: checking Haskell type for float" >&5+$as_echo_n "checking Haskell type for float... " >&6; }+    if test "${fptools_cv_htype_float+set}" = set; then :+  $as_echo_n "(cached) " >&6+else++        fptools_cv_htype_sup_float=yes+        if ac_fn_c_compute_int "$LINENO" "((float)((int)((float)1.4))) == ((float)1.4)" "HTYPE_IS_INTEGRAL"        "+#include <stdio.h>+#include <stddef.h>++#if HAVE_SYS_TYPES_H+# include <sys/types.h>+#endif++#if HAVE_UNISTD_H+# include <unistd.h>+#endif++#if HAVE_SYS_STAT_H+# include <sys/stat.h>+#endif++#if HAVE_FCNTL_H+# include <fcntl.h>+#endif++#if HAVE_SIGNAL_H+# include <signal.h>+#endif++#if HAVE_TIME_H+# include <time.h>+#endif++#if HAVE_TERMIOS_H+# include <termios.h>+#endif++#if HAVE_STRING_H+# include <string.h>+#endif++#if HAVE_CTYPE_H+# include <ctype.h>+#endif++#if HAVE_INTTYPES_H+# include <inttypes.h>+#else+# if HAVE_STDINT_H+#  include <stdint.h>+# endif+#endif++#if HAVE_SYS_RESOURCE_H+# include <sys/resource.h>+#endif++#include <stdlib.h>+"; then :++else+  fptools_cv_htype_sup_float=no+fi+++        if test "$fptools_cv_htype_sup_float" = "yes"+        then+            if test "$HTYPE_IS_INTEGRAL" -eq 0+            then+                if ac_fn_c_compute_int "$LINENO" "sizeof(float) == sizeof(float)" "HTYPE_IS_FLOAT"        "+#include <stdio.h>+#include <stddef.h>++#if HAVE_SYS_TYPES_H+# include <sys/types.h>+#endif++#if HAVE_UNISTD_H+# include <unistd.h>+#endif++#if HAVE_SYS_STAT_H+# include <sys/stat.h>+#endif++#if HAVE_FCNTL_H+# include <fcntl.h>+#endif++#if HAVE_SIGNAL_H+# include <signal.h>+#endif++#if HAVE_TIME_H+# include <time.h>+#endif++#if HAVE_TERMIOS_H+# include <termios.h>+#endif++#if HAVE_STRING_H+# include <string.h>+#endif++#if HAVE_CTYPE_H+# include <ctype.h>+#endif++#if HAVE_INTTYPES_H+# include <inttypes.h>+#else+# if HAVE_STDINT_H+#  include <stdint.h>+# endif+#endif++#if HAVE_SYS_RESOURCE_H+# include <sys/resource.h>+#endif++#include <stdlib.h>+"; then :++else+  fptools_cv_htype_sup_float=no+fi+++                if ac_fn_c_compute_int "$LINENO" "sizeof(float) == sizeof(double)" "HTYPE_IS_DOUBLE"        "+#include <stdio.h>+#include <stddef.h>++#if HAVE_SYS_TYPES_H+# include <sys/types.h>+#endif++#if HAVE_UNISTD_H+# include <unistd.h>+#endif++#if HAVE_SYS_STAT_H+# include <sys/stat.h>+#endif++#if HAVE_FCNTL_H+# include <fcntl.h>+#endif++#if HAVE_SIGNAL_H+# include <signal.h>+#endif++#if HAVE_TIME_H+# include <time.h>+#endif++#if HAVE_TERMIOS_H+# include <termios.h>+#endif++#if HAVE_STRING_H+# include <string.h>+#endif++#if HAVE_CTYPE_H+# include <ctype.h>+#endif++#if HAVE_INTTYPES_H+# include <inttypes.h>+#else+# if HAVE_STDINT_H+#  include <stdint.h>+# endif+#endif++#if HAVE_SYS_RESOURCE_H+# include <sys/resource.h>+#endif++#include <stdlib.h>+"; then :++else+  fptools_cv_htype_sup_float=no+fi+++                if ac_fn_c_compute_int "$LINENO" "sizeof(float) == sizeof(long double)" "HTYPE_IS_LDOUBLE"        "+#include <stdio.h>+#include <stddef.h>++#if HAVE_SYS_TYPES_H+# include <sys/types.h>+#endif++#if HAVE_UNISTD_H+# include <unistd.h>+#endif++#if HAVE_SYS_STAT_H+# include <sys/stat.h>+#endif++#if HAVE_FCNTL_H+# include <fcntl.h>+#endif++#if HAVE_SIGNAL_H+# include <signal.h>+#endif++#if HAVE_TIME_H+# include <time.h>+#endif++#if HAVE_TERMIOS_H+# include <termios.h>+#endif++#if HAVE_STRING_H+# include <string.h>+#endif++#if HAVE_CTYPE_H+# include <ctype.h>+#endif++#if HAVE_INTTYPES_H+# include <inttypes.h>+#else+# if HAVE_STDINT_H+#  include <stdint.h>+# endif+#endif++#if HAVE_SYS_RESOURCE_H+# include <sys/resource.h>+#endif++#include <stdlib.h>+"; then :++else+  fptools_cv_htype_sup_float=no+fi+++                if test "$HTYPE_IS_FLOAT" -eq 1+                then+                    fptools_cv_htype_float=Float+                elif test "$HTYPE_IS_DOUBLE" -eq 1+                then+                    fptools_cv_htype_float=Double+                elif test "$HTYPE_IS_LDOUBLE" -eq 1+                then+                    fptools_cv_htype_float=LDouble+                else+                    fptools_cv_htype_sup_float=no+                fi+            else+                if ac_fn_c_compute_int "$LINENO" "((float)(-1)) < ((float)0)" "HTYPE_IS_SIGNED"        "+#include <stdio.h>+#include <stddef.h>++#if HAVE_SYS_TYPES_H+# include <sys/types.h>+#endif++#if HAVE_UNISTD_H+# include <unistd.h>+#endif++#if HAVE_SYS_STAT_H+# include <sys/stat.h>+#endif++#if HAVE_FCNTL_H+# include <fcntl.h>+#endif++#if HAVE_SIGNAL_H+# include <signal.h>+#endif++#if HAVE_TIME_H+# include <time.h>+#endif++#if HAVE_TERMIOS_H+# include <termios.h>+#endif++#if HAVE_STRING_H+# include <string.h>+#endif++#if HAVE_CTYPE_H+# include <ctype.h>+#endif++#if HAVE_INTTYPES_H+# include <inttypes.h>+#else+# if HAVE_STDINT_H+#  include <stdint.h>+# endif+#endif++#if HAVE_SYS_RESOURCE_H+# include <sys/resource.h>+#endif++#include <stdlib.h>+"; then :++else+  fptools_cv_htype_sup_float=no+fi+++                if ac_fn_c_compute_int "$LINENO" "sizeof(float) * 8" "HTYPE_SIZE"        "+#include <stdio.h>+#include <stddef.h>++#if HAVE_SYS_TYPES_H+# include <sys/types.h>+#endif++#if HAVE_UNISTD_H+# include <unistd.h>+#endif++#if HAVE_SYS_STAT_H+# include <sys/stat.h>+#endif++#if HAVE_FCNTL_H+# include <fcntl.h>+#endif++#if HAVE_SIGNAL_H+# include <signal.h>+#endif++#if HAVE_TIME_H+# include <time.h>+#endif++#if HAVE_TERMIOS_H+# include <termios.h>+#endif++#if HAVE_STRING_H+# include <string.h>+#endif++#if HAVE_CTYPE_H+# include <ctype.h>+#endif++#if HAVE_INTTYPES_H+# include <inttypes.h>+#else+# if HAVE_STDINT_H+#  include <stdint.h>+# endif+#endif++#if HAVE_SYS_RESOURCE_H+# include <sys/resource.h>+#endif++#include <stdlib.h>+"; then :++else+  fptools_cv_htype_sup_float=no+fi+++                if test "$HTYPE_IS_SIGNED" -eq 0+                then+                    fptools_cv_htype_float="Word$HTYPE_SIZE"+                else+                    fptools_cv_htype_float="Int$HTYPE_SIZE"+                fi+            fi+        fi++fi++    if test "$fptools_cv_htype_sup_float" = no+    then++        fptools_cv_htype_float=NotReallyAType+        { $as_echo "$as_me:${as_lineno-$LINENO}: result: not supported" >&5+$as_echo "not supported" >&6; }++    fi++            if test "$fptools_cv_htype_sup_float" = yes; then+        { $as_echo "$as_me:${as_lineno-$LINENO}: result: $fptools_cv_htype_float" >&5+$as_echo "$fptools_cv_htype_float" >&6; }++cat >>confdefs.h <<_ACEOF+#define HTYPE_FLOAT $fptools_cv_htype_float+_ACEOF++    fi+++++++++++    { $as_echo "$as_me:${as_lineno-$LINENO}: checking Haskell type for double" >&5+$as_echo_n "checking Haskell type for double... " >&6; }+    if test "${fptools_cv_htype_double+set}" = set; then :+  $as_echo_n "(cached) " >&6+else++        fptools_cv_htype_sup_double=yes+        if ac_fn_c_compute_int "$LINENO" "((double)((int)((double)1.4))) == ((double)1.4)" "HTYPE_IS_INTEGRAL"        "+#include <stdio.h>+#include <stddef.h>++#if HAVE_SYS_TYPES_H+# include <sys/types.h>+#endif++#if HAVE_UNISTD_H+# include <unistd.h>+#endif++#if HAVE_SYS_STAT_H+# include <sys/stat.h>+#endif++#if HAVE_FCNTL_H+# include <fcntl.h>+#endif++#if HAVE_SIGNAL_H+# include <signal.h>+#endif++#if HAVE_TIME_H+# include <time.h>+#endif++#if HAVE_TERMIOS_H+# include <termios.h>+#endif++#if HAVE_STRING_H+# include <string.h>+#endif++#if HAVE_CTYPE_H+# include <ctype.h>+#endif++#if HAVE_INTTYPES_H+# include <inttypes.h>+#else+# if HAVE_STDINT_H+#  include <stdint.h>+# endif+#endif++#if HAVE_SYS_RESOURCE_H+# include <sys/resource.h>+#endif++#include <stdlib.h>+"; then :++else+  fptools_cv_htype_sup_double=no+fi+++        if test "$fptools_cv_htype_sup_double" = "yes"+        then+            if test "$HTYPE_IS_INTEGRAL" -eq 0+            then+                if ac_fn_c_compute_int "$LINENO" "sizeof(double) == sizeof(float)" "HTYPE_IS_FLOAT"        "+#include <stdio.h>+#include <stddef.h>++#if HAVE_SYS_TYPES_H+# include <sys/types.h>+#endif++#if HAVE_UNISTD_H+# include <unistd.h>+#endif++#if HAVE_SYS_STAT_H+# include <sys/stat.h>+#endif++#if HAVE_FCNTL_H+# include <fcntl.h>+#endif++#if HAVE_SIGNAL_H+# include <signal.h>+#endif++#if HAVE_TIME_H+# include <time.h>+#endif++#if HAVE_TERMIOS_H+# include <termios.h>+#endif++#if HAVE_STRING_H+# include <string.h>+#endif++#if HAVE_CTYPE_H+# include <ctype.h>+#endif++#if HAVE_INTTYPES_H+# include <inttypes.h>+#else+# if HAVE_STDINT_H+#  include <stdint.h>+# endif+#endif++#if HAVE_SYS_RESOURCE_H+# include <sys/resource.h>+#endif++#include <stdlib.h>+"; then :++else+  fptools_cv_htype_sup_double=no+fi+++                if ac_fn_c_compute_int "$LINENO" "sizeof(double) == sizeof(double)" "HTYPE_IS_DOUBLE"        "+#include <stdio.h>+#include <stddef.h>++#if HAVE_SYS_TYPES_H+# include <sys/types.h>+#endif++#if HAVE_UNISTD_H+# include <unistd.h>+#endif++#if HAVE_SYS_STAT_H+# include <sys/stat.h>+#endif++#if HAVE_FCNTL_H+# include <fcntl.h>+#endif++#if HAVE_SIGNAL_H+# include <signal.h>+#endif++#if HAVE_TIME_H+# include <time.h>+#endif++#if HAVE_TERMIOS_H+# include <termios.h>+#endif++#if HAVE_STRING_H+# include <string.h>+#endif++#if HAVE_CTYPE_H+# include <ctype.h>+#endif++#if HAVE_INTTYPES_H+# include <inttypes.h>+#else+# if HAVE_STDINT_H+#  include <stdint.h>+# endif+#endif++#if HAVE_SYS_RESOURCE_H+# include <sys/resource.h>+#endif++#include <stdlib.h>+"; then :++else+  fptools_cv_htype_sup_double=no+fi+++                if ac_fn_c_compute_int "$LINENO" "sizeof(double) == sizeof(long double)" "HTYPE_IS_LDOUBLE"        "+#include <stdio.h>+#include <stddef.h>++#if HAVE_SYS_TYPES_H+# include <sys/types.h>+#endif++#if HAVE_UNISTD_H+# include <unistd.h>+#endif++#if HAVE_SYS_STAT_H+# include <sys/stat.h>+#endif++#if HAVE_FCNTL_H+# include <fcntl.h>+#endif++#if HAVE_SIGNAL_H+# include <signal.h>+#endif++#if HAVE_TIME_H+# include <time.h>+#endif++#if HAVE_TERMIOS_H+# include <termios.h>+#endif++#if HAVE_STRING_H+# include <string.h>+#endif++#if HAVE_CTYPE_H+# include <ctype.h>+#endif++#if HAVE_INTTYPES_H+# include <inttypes.h>+#else+# if HAVE_STDINT_H+#  include <stdint.h>+# endif+#endif++#if HAVE_SYS_RESOURCE_H+# include <sys/resource.h>+#endif++#include <stdlib.h>+"; then :++else+  fptools_cv_htype_sup_double=no+fi+++                if test "$HTYPE_IS_FLOAT" -eq 1+                then+                    fptools_cv_htype_double=Float+                elif test "$HTYPE_IS_DOUBLE" -eq 1+                then+                    fptools_cv_htype_double=Double+                elif test "$HTYPE_IS_LDOUBLE" -eq 1+                then+                    fptools_cv_htype_double=LDouble+                else+                    fptools_cv_htype_sup_double=no+                fi+            else+                if ac_fn_c_compute_int "$LINENO" "((double)(-1)) < ((double)0)" "HTYPE_IS_SIGNED"        "+#include <stdio.h>+#include <stddef.h>++#if HAVE_SYS_TYPES_H+# include <sys/types.h>+#endif++#if HAVE_UNISTD_H+# include <unistd.h>+#endif++#if HAVE_SYS_STAT_H+# include <sys/stat.h>+#endif++#if HAVE_FCNTL_H+# include <fcntl.h>+#endif++#if HAVE_SIGNAL_H+# include <signal.h>+#endif++#if HAVE_TIME_H+# include <time.h>+#endif++#if HAVE_TERMIOS_H+# include <termios.h>+#endif++#if HAVE_STRING_H+# include <string.h>+#endif++#if HAVE_CTYPE_H+# include <ctype.h>+#endif++#if HAVE_INTTYPES_H+# include <inttypes.h>+#else+# if HAVE_STDINT_H+#  include <stdint.h>+# endif+#endif++#if HAVE_SYS_RESOURCE_H+# include <sys/resource.h>+#endif++#include <stdlib.h>+"; then :++else+  fptools_cv_htype_sup_double=no+fi+++                if ac_fn_c_compute_int "$LINENO" "sizeof(double) * 8" "HTYPE_SIZE"        "+#include <stdio.h>+#include <stddef.h>++#if HAVE_SYS_TYPES_H+# include <sys/types.h>+#endif++#if HAVE_UNISTD_H+# include <unistd.h>+#endif++#if HAVE_SYS_STAT_H+# include <sys/stat.h>+#endif++#if HAVE_FCNTL_H+# include <fcntl.h>+#endif++#if HAVE_SIGNAL_H+# include <signal.h>+#endif++#if HAVE_TIME_H+# include <time.h>+#endif++#if HAVE_TERMIOS_H+# include <termios.h>+#endif++#if HAVE_STRING_H+# include <string.h>+#endif++#if HAVE_CTYPE_H+# include <ctype.h>+#endif++#if HAVE_INTTYPES_H+# include <inttypes.h>+#else+# if HAVE_STDINT_H+#  include <stdint.h>+# endif+#endif++#if HAVE_SYS_RESOURCE_H+# include <sys/resource.h>+#endif++#include <stdlib.h>+"; then :++else+  fptools_cv_htype_sup_double=no+fi+++                if test "$HTYPE_IS_SIGNED" -eq 0+                then+                    fptools_cv_htype_double="Word$HTYPE_SIZE"+                else+                    fptools_cv_htype_double="Int$HTYPE_SIZE"+                fi+            fi+        fi++fi++    if test "$fptools_cv_htype_sup_double" = no+    then++        fptools_cv_htype_double=NotReallyAType+        { $as_echo "$as_me:${as_lineno-$LINENO}: result: not supported" >&5+$as_echo "not supported" >&6; }++    fi++            if test "$fptools_cv_htype_sup_double" = yes; then+        { $as_echo "$as_me:${as_lineno-$LINENO}: result: $fptools_cv_htype_double" >&5+$as_echo "$fptools_cv_htype_double" >&6; }++cat >>confdefs.h <<_ACEOF+#define HTYPE_DOUBLE $fptools_cv_htype_double+_ACEOF++    fi+++++++++++    { $as_echo "$as_me:${as_lineno-$LINENO}: checking Haskell type for ptrdiff_t" >&5+$as_echo_n "checking Haskell type for ptrdiff_t... " >&6; }+    if test "${fptools_cv_htype_ptrdiff_t+set}" = set; then :+  $as_echo_n "(cached) " >&6+else++        fptools_cv_htype_sup_ptrdiff_t=yes+        if ac_fn_c_compute_int "$LINENO" "((ptrdiff_t)((int)((ptrdiff_t)1.4))) == ((ptrdiff_t)1.4)" "HTYPE_IS_INTEGRAL"        "+#include <stdio.h>+#include <stddef.h>++#if HAVE_SYS_TYPES_H+# include <sys/types.h>+#endif++#if HAVE_UNISTD_H+# include <unistd.h>+#endif++#if HAVE_SYS_STAT_H+# include <sys/stat.h>+#endif++#if HAVE_FCNTL_H+# include <fcntl.h>+#endif++#if HAVE_SIGNAL_H+# include <signal.h>+#endif++#if HAVE_TIME_H+# include <time.h>+#endif++#if HAVE_TERMIOS_H+# include <termios.h>+#endif++#if HAVE_STRING_H+# include <string.h>+#endif++#if HAVE_CTYPE_H+# include <ctype.h>+#endif++#if HAVE_INTTYPES_H+# include <inttypes.h>+#else+# if HAVE_STDINT_H+#  include <stdint.h>+# endif+#endif++#if HAVE_SYS_RESOURCE_H+# include <sys/resource.h>+#endif++#include <stdlib.h>+"; then :++else+  fptools_cv_htype_sup_ptrdiff_t=no+fi+++        if test "$fptools_cv_htype_sup_ptrdiff_t" = "yes"+        then+            if test "$HTYPE_IS_INTEGRAL" -eq 0+            then+                if ac_fn_c_compute_int "$LINENO" "sizeof(ptrdiff_t) == sizeof(float)" "HTYPE_IS_FLOAT"        "+#include <stdio.h>+#include <stddef.h>++#if HAVE_SYS_TYPES_H+# include <sys/types.h>+#endif++#if HAVE_UNISTD_H+# include <unistd.h>+#endif++#if HAVE_SYS_STAT_H+# include <sys/stat.h>+#endif++#if HAVE_FCNTL_H+# include <fcntl.h>+#endif++#if HAVE_SIGNAL_H+# include <signal.h>+#endif++#if HAVE_TIME_H+# include <time.h>+#endif++#if HAVE_TERMIOS_H+# include <termios.h>+#endif++#if HAVE_STRING_H+# include <string.h>+#endif++#if HAVE_CTYPE_H+# include <ctype.h>+#endif++#if HAVE_INTTYPES_H+# include <inttypes.h>+#else+# if HAVE_STDINT_H+#  include <stdint.h>+# endif+#endif++#if HAVE_SYS_RESOURCE_H+# include <sys/resource.h>+#endif++#include <stdlib.h>+"; then :++else+  fptools_cv_htype_sup_ptrdiff_t=no+fi+++                if ac_fn_c_compute_int "$LINENO" "sizeof(ptrdiff_t) == sizeof(double)" "HTYPE_IS_DOUBLE"        "+#include <stdio.h>+#include <stddef.h>++#if HAVE_SYS_TYPES_H+# include <sys/types.h>+#endif++#if HAVE_UNISTD_H+# include <unistd.h>+#endif++#if HAVE_SYS_STAT_H+# include <sys/stat.h>+#endif++#if HAVE_FCNTL_H+# include <fcntl.h>+#endif++#if HAVE_SIGNAL_H+# include <signal.h>+#endif++#if HAVE_TIME_H+# include <time.h>+#endif++#if HAVE_TERMIOS_H+# include <termios.h>+#endif++#if HAVE_STRING_H+# include <string.h>+#endif++#if HAVE_CTYPE_H+# include <ctype.h>+#endif++#if HAVE_INTTYPES_H+# include <inttypes.h>+#else+# if HAVE_STDINT_H+#  include <stdint.h>+# endif+#endif++#if HAVE_SYS_RESOURCE_H+# include <sys/resource.h>+#endif++#include <stdlib.h>+"; then :++else+  fptools_cv_htype_sup_ptrdiff_t=no+fi+++                if ac_fn_c_compute_int "$LINENO" "sizeof(ptrdiff_t) == sizeof(long double)" "HTYPE_IS_LDOUBLE"        "+#include <stdio.h>+#include <stddef.h>++#if HAVE_SYS_TYPES_H+# include <sys/types.h>+#endif++#if HAVE_UNISTD_H+# include <unistd.h>+#endif++#if HAVE_SYS_STAT_H+# include <sys/stat.h>+#endif++#if HAVE_FCNTL_H+# include <fcntl.h>+#endif++#if HAVE_SIGNAL_H+# include <signal.h>+#endif++#if HAVE_TIME_H+# include <time.h>+#endif++#if HAVE_TERMIOS_H+# include <termios.h>+#endif++#if HAVE_STRING_H+# include <string.h>+#endif++#if HAVE_CTYPE_H+# include <ctype.h>+#endif++#if HAVE_INTTYPES_H+# include <inttypes.h>+#else+# if HAVE_STDINT_H+#  include <stdint.h>+# endif+#endif++#if HAVE_SYS_RESOURCE_H+# include <sys/resource.h>+#endif++#include <stdlib.h>+"; then :++else+  fptools_cv_htype_sup_ptrdiff_t=no+fi+++                if test "$HTYPE_IS_FLOAT" -eq 1+                then+                    fptools_cv_htype_ptrdiff_t=Float+                elif test "$HTYPE_IS_DOUBLE" -eq 1+                then+                    fptools_cv_htype_ptrdiff_t=Double+                elif test "$HTYPE_IS_LDOUBLE" -eq 1+                then+                    fptools_cv_htype_ptrdiff_t=LDouble+                else+                    fptools_cv_htype_sup_ptrdiff_t=no+                fi+            else+                if ac_fn_c_compute_int "$LINENO" "((ptrdiff_t)(-1)) < ((ptrdiff_t)0)" "HTYPE_IS_SIGNED"        "+#include <stdio.h>+#include <stddef.h>++#if HAVE_SYS_TYPES_H+# include <sys/types.h>+#endif++#if HAVE_UNISTD_H+# include <unistd.h>+#endif++#if HAVE_SYS_STAT_H+# include <sys/stat.h>+#endif++#if HAVE_FCNTL_H+# include <fcntl.h>+#endif++#if HAVE_SIGNAL_H+# include <signal.h>+#endif++#if HAVE_TIME_H+# include <time.h>+#endif++#if HAVE_TERMIOS_H+# include <termios.h>+#endif++#if HAVE_STRING_H+# include <string.h>+#endif++#if HAVE_CTYPE_H+# include <ctype.h>+#endif++#if HAVE_INTTYPES_H+# include <inttypes.h>+#else+# if HAVE_STDINT_H+#  include <stdint.h>+# endif+#endif++#if HAVE_SYS_RESOURCE_H+# include <sys/resource.h>+#endif++#include <stdlib.h>+"; then :++else+  fptools_cv_htype_sup_ptrdiff_t=no+fi+++                if ac_fn_c_compute_int "$LINENO" "sizeof(ptrdiff_t) * 8" "HTYPE_SIZE"        "+#include <stdio.h>+#include <stddef.h>++#if HAVE_SYS_TYPES_H+# include <sys/types.h>+#endif++#if HAVE_UNISTD_H+# include <unistd.h>+#endif++#if HAVE_SYS_STAT_H+# include <sys/stat.h>+#endif++#if HAVE_FCNTL_H+# include <fcntl.h>+#endif++#if HAVE_SIGNAL_H+# include <signal.h>+#endif++#if HAVE_TIME_H+# include <time.h>+#endif++#if HAVE_TERMIOS_H+# include <termios.h>+#endif++#if HAVE_STRING_H+# include <string.h>+#endif++#if HAVE_CTYPE_H+# include <ctype.h>+#endif++#if HAVE_INTTYPES_H+# include <inttypes.h>+#else+# if HAVE_STDINT_H+#  include <stdint.h>+# endif+#endif++#if HAVE_SYS_RESOURCE_H+# include <sys/resource.h>+#endif++#include <stdlib.h>+"; then :++else+  fptools_cv_htype_sup_ptrdiff_t=no+fi+++                if test "$HTYPE_IS_SIGNED" -eq 0+                then+                    fptools_cv_htype_ptrdiff_t="Word$HTYPE_SIZE"+                else+                    fptools_cv_htype_ptrdiff_t="Int$HTYPE_SIZE"+                fi+            fi+        fi++fi++    if test "$fptools_cv_htype_sup_ptrdiff_t" = no+    then++        fptools_cv_htype_ptrdiff_t=NotReallyAType+        { $as_echo "$as_me:${as_lineno-$LINENO}: result: not supported" >&5+$as_echo "not supported" >&6; }++    fi++            if test "$fptools_cv_htype_sup_ptrdiff_t" = yes; then+        { $as_echo "$as_me:${as_lineno-$LINENO}: result: $fptools_cv_htype_ptrdiff_t" >&5+$as_echo "$fptools_cv_htype_ptrdiff_t" >&6; }++cat >>confdefs.h <<_ACEOF+#define HTYPE_PTRDIFF_T $fptools_cv_htype_ptrdiff_t+_ACEOF++    fi+++++++++++    { $as_echo "$as_me:${as_lineno-$LINENO}: checking Haskell type for size_t" >&5+$as_echo_n "checking Haskell type for size_t... " >&6; }+    if test "${fptools_cv_htype_size_t+set}" = set; then :+  $as_echo_n "(cached) " >&6+else++        fptools_cv_htype_sup_size_t=yes+        if ac_fn_c_compute_int "$LINENO" "((size_t)((int)((size_t)1.4))) == ((size_t)1.4)" "HTYPE_IS_INTEGRAL"        "+#include <stdio.h>+#include <stddef.h>++#if HAVE_SYS_TYPES_H+# include <sys/types.h>+#endif++#if HAVE_UNISTD_H+# include <unistd.h>+#endif++#if HAVE_SYS_STAT_H+# include <sys/stat.h>+#endif++#if HAVE_FCNTL_H+# include <fcntl.h>+#endif++#if HAVE_SIGNAL_H+# include <signal.h>+#endif++#if HAVE_TIME_H+# include <time.h>+#endif++#if HAVE_TERMIOS_H+# include <termios.h>+#endif++#if HAVE_STRING_H+# include <string.h>+#endif++#if HAVE_CTYPE_H+# include <ctype.h>+#endif++#if HAVE_INTTYPES_H+# include <inttypes.h>+#else+# if HAVE_STDINT_H+#  include <stdint.h>+# endif+#endif++#if HAVE_SYS_RESOURCE_H+# include <sys/resource.h>+#endif++#include <stdlib.h>+"; then :++else+  fptools_cv_htype_sup_size_t=no+fi+++        if test "$fptools_cv_htype_sup_size_t" = "yes"+        then+            if test "$HTYPE_IS_INTEGRAL" -eq 0+            then+                if ac_fn_c_compute_int "$LINENO" "sizeof(size_t) == sizeof(float)" "HTYPE_IS_FLOAT"        "+#include <stdio.h>+#include <stddef.h>++#if HAVE_SYS_TYPES_H+# include <sys/types.h>+#endif++#if HAVE_UNISTD_H+# include <unistd.h>+#endif++#if HAVE_SYS_STAT_H+# include <sys/stat.h>+#endif++#if HAVE_FCNTL_H+# include <fcntl.h>+#endif++#if HAVE_SIGNAL_H+# include <signal.h>+#endif++#if HAVE_TIME_H+# include <time.h>+#endif++#if HAVE_TERMIOS_H+# include <termios.h>+#endif++#if HAVE_STRING_H+# include <string.h>+#endif++#if HAVE_CTYPE_H+# include <ctype.h>+#endif++#if HAVE_INTTYPES_H+# include <inttypes.h>+#else+# if HAVE_STDINT_H+#  include <stdint.h>+# endif+#endif++#if HAVE_SYS_RESOURCE_H+# include <sys/resource.h>+#endif++#include <stdlib.h>+"; then :++else+  fptools_cv_htype_sup_size_t=no+fi+++                if ac_fn_c_compute_int "$LINENO" "sizeof(size_t) == sizeof(double)" "HTYPE_IS_DOUBLE"        "+#include <stdio.h>+#include <stddef.h>++#if HAVE_SYS_TYPES_H+# include <sys/types.h>+#endif++#if HAVE_UNISTD_H+# include <unistd.h>+#endif++#if HAVE_SYS_STAT_H+# include <sys/stat.h>+#endif++#if HAVE_FCNTL_H+# include <fcntl.h>+#endif++#if HAVE_SIGNAL_H+# include <signal.h>+#endif++#if HAVE_TIME_H+# include <time.h>+#endif++#if HAVE_TERMIOS_H+# include <termios.h>+#endif++#if HAVE_STRING_H+# include <string.h>+#endif++#if HAVE_CTYPE_H+# include <ctype.h>+#endif++#if HAVE_INTTYPES_H+# include <inttypes.h>+#else+# if HAVE_STDINT_H+#  include <stdint.h>+# endif+#endif++#if HAVE_SYS_RESOURCE_H+# include <sys/resource.h>+#endif++#include <stdlib.h>+"; then :++else+  fptools_cv_htype_sup_size_t=no+fi+++                if ac_fn_c_compute_int "$LINENO" "sizeof(size_t) == sizeof(long double)" "HTYPE_IS_LDOUBLE"        "+#include <stdio.h>+#include <stddef.h>++#if HAVE_SYS_TYPES_H+# include <sys/types.h>+#endif++#if HAVE_UNISTD_H+# include <unistd.h>+#endif++#if HAVE_SYS_STAT_H+# include <sys/stat.h>+#endif++#if HAVE_FCNTL_H+# include <fcntl.h>+#endif++#if HAVE_SIGNAL_H+# include <signal.h>+#endif++#if HAVE_TIME_H+# include <time.h>+#endif++#if HAVE_TERMIOS_H+# include <termios.h>+#endif++#if HAVE_STRING_H+# include <string.h>+#endif++#if HAVE_CTYPE_H+# include <ctype.h>+#endif++#if HAVE_INTTYPES_H+# include <inttypes.h>+#else+# if HAVE_STDINT_H+#  include <stdint.h>+# endif+#endif++#if HAVE_SYS_RESOURCE_H+# include <sys/resource.h>+#endif++#include <stdlib.h>+"; then :++else+  fptools_cv_htype_sup_size_t=no+fi+++                if test "$HTYPE_IS_FLOAT" -eq 1+                then+                    fptools_cv_htype_size_t=Float+                elif test "$HTYPE_IS_DOUBLE" -eq 1+                then+                    fptools_cv_htype_size_t=Double+                elif test "$HTYPE_IS_LDOUBLE" -eq 1+                then+                    fptools_cv_htype_size_t=LDouble+                else+                    fptools_cv_htype_sup_size_t=no+                fi+            else+                if ac_fn_c_compute_int "$LINENO" "((size_t)(-1)) < ((size_t)0)" "HTYPE_IS_SIGNED"        "+#include <stdio.h>+#include <stddef.h>++#if HAVE_SYS_TYPES_H+# include <sys/types.h>+#endif++#if HAVE_UNISTD_H+# include <unistd.h>+#endif++#if HAVE_SYS_STAT_H+# include <sys/stat.h>+#endif++#if HAVE_FCNTL_H+# include <fcntl.h>+#endif++#if HAVE_SIGNAL_H+# include <signal.h>+#endif++#if HAVE_TIME_H+# include <time.h>+#endif++#if HAVE_TERMIOS_H+# include <termios.h>+#endif++#if HAVE_STRING_H+# include <string.h>+#endif++#if HAVE_CTYPE_H+# include <ctype.h>+#endif++#if HAVE_INTTYPES_H+# include <inttypes.h>+#else+# if HAVE_STDINT_H+#  include <stdint.h>+# endif+#endif++#if HAVE_SYS_RESOURCE_H+# include <sys/resource.h>+#endif++#include <stdlib.h>+"; then :++else+  fptools_cv_htype_sup_size_t=no+fi+++                if ac_fn_c_compute_int "$LINENO" "sizeof(size_t) * 8" "HTYPE_SIZE"        "+#include <stdio.h>+#include <stddef.h>++#if HAVE_SYS_TYPES_H+# include <sys/types.h>+#endif++#if HAVE_UNISTD_H+# include <unistd.h>+#endif++#if HAVE_SYS_STAT_H+# include <sys/stat.h>+#endif++#if HAVE_FCNTL_H+# include <fcntl.h>+#endif++#if HAVE_SIGNAL_H+# include <signal.h>+#endif++#if HAVE_TIME_H+# include <time.h>+#endif++#if HAVE_TERMIOS_H+# include <termios.h>+#endif++#if HAVE_STRING_H+# include <string.h>+#endif++#if HAVE_CTYPE_H+# include <ctype.h>+#endif++#if HAVE_INTTYPES_H+# include <inttypes.h>+#else+# if HAVE_STDINT_H+#  include <stdint.h>+# endif+#endif++#if HAVE_SYS_RESOURCE_H+# include <sys/resource.h>+#endif++#include <stdlib.h>+"; then :++else+  fptools_cv_htype_sup_size_t=no+fi+++                if test "$HTYPE_IS_SIGNED" -eq 0+                then+                    fptools_cv_htype_size_t="Word$HTYPE_SIZE"+                else+                    fptools_cv_htype_size_t="Int$HTYPE_SIZE"+                fi+            fi+        fi++fi++    if test "$fptools_cv_htype_sup_size_t" = no+    then++        fptools_cv_htype_size_t=NotReallyAType+        { $as_echo "$as_me:${as_lineno-$LINENO}: result: not supported" >&5+$as_echo "not supported" >&6; }++    fi++            if test "$fptools_cv_htype_sup_size_t" = yes; then+        { $as_echo "$as_me:${as_lineno-$LINENO}: result: $fptools_cv_htype_size_t" >&5+$as_echo "$fptools_cv_htype_size_t" >&6; }++cat >>confdefs.h <<_ACEOF+#define HTYPE_SIZE_T $fptools_cv_htype_size_t+_ACEOF++    fi+++++++++++    { $as_echo "$as_me:${as_lineno-$LINENO}: checking Haskell type for wchar_t" >&5+$as_echo_n "checking Haskell type for wchar_t... " >&6; }+    if test "${fptools_cv_htype_wchar_t+set}" = set; then :+  $as_echo_n "(cached) " >&6+else++        fptools_cv_htype_sup_wchar_t=yes+        if ac_fn_c_compute_int "$LINENO" "((wchar_t)((int)((wchar_t)1.4))) == ((wchar_t)1.4)" "HTYPE_IS_INTEGRAL"        "+#include <stdio.h>+#include <stddef.h>++#if HAVE_SYS_TYPES_H+# include <sys/types.h>+#endif++#if HAVE_UNISTD_H+# include <unistd.h>+#endif++#if HAVE_SYS_STAT_H+# include <sys/stat.h>+#endif++#if HAVE_FCNTL_H+# include <fcntl.h>+#endif++#if HAVE_SIGNAL_H+# include <signal.h>+#endif++#if HAVE_TIME_H+# include <time.h>+#endif++#if HAVE_TERMIOS_H+# include <termios.h>+#endif++#if HAVE_STRING_H+# include <string.h>+#endif++#if HAVE_CTYPE_H+# include <ctype.h>+#endif++#if HAVE_INTTYPES_H+# include <inttypes.h>+#else+# if HAVE_STDINT_H+#  include <stdint.h>+# endif+#endif++#if HAVE_SYS_RESOURCE_H+# include <sys/resource.h>+#endif++#include <stdlib.h>+"; then :++else+  fptools_cv_htype_sup_wchar_t=no+fi+++        if test "$fptools_cv_htype_sup_wchar_t" = "yes"+        then+            if test "$HTYPE_IS_INTEGRAL" -eq 0+            then+                if ac_fn_c_compute_int "$LINENO" "sizeof(wchar_t) == sizeof(float)" "HTYPE_IS_FLOAT"        "+#include <stdio.h>+#include <stddef.h>++#if HAVE_SYS_TYPES_H+# include <sys/types.h>+#endif++#if HAVE_UNISTD_H+# include <unistd.h>+#endif++#if HAVE_SYS_STAT_H+# include <sys/stat.h>+#endif++#if HAVE_FCNTL_H+# include <fcntl.h>+#endif++#if HAVE_SIGNAL_H+# include <signal.h>+#endif++#if HAVE_TIME_H+# include <time.h>+#endif++#if HAVE_TERMIOS_H+# include <termios.h>+#endif++#if HAVE_STRING_H+# include <string.h>+#endif++#if HAVE_CTYPE_H+# include <ctype.h>+#endif++#if HAVE_INTTYPES_H+# include <inttypes.h>+#else+# if HAVE_STDINT_H+#  include <stdint.h>+# endif+#endif++#if HAVE_SYS_RESOURCE_H+# include <sys/resource.h>+#endif++#include <stdlib.h>+"; then :++else+  fptools_cv_htype_sup_wchar_t=no+fi+++                if ac_fn_c_compute_int "$LINENO" "sizeof(wchar_t) == sizeof(double)" "HTYPE_IS_DOUBLE"        "+#include <stdio.h>+#include <stddef.h>++#if HAVE_SYS_TYPES_H+# include <sys/types.h>+#endif++#if HAVE_UNISTD_H+# include <unistd.h>+#endif++#if HAVE_SYS_STAT_H+# include <sys/stat.h>+#endif++#if HAVE_FCNTL_H+# include <fcntl.h>+#endif++#if HAVE_SIGNAL_H+# include <signal.h>+#endif++#if HAVE_TIME_H+# include <time.h>+#endif++#if HAVE_TERMIOS_H+# include <termios.h>+#endif++#if HAVE_STRING_H+# include <string.h>+#endif++#if HAVE_CTYPE_H+# include <ctype.h>+#endif++#if HAVE_INTTYPES_H+# include <inttypes.h>+#else+# if HAVE_STDINT_H+#  include <stdint.h>+# endif+#endif++#if HAVE_SYS_RESOURCE_H+# include <sys/resource.h>+#endif++#include <stdlib.h>+"; then :++else+  fptools_cv_htype_sup_wchar_t=no+fi+++                if ac_fn_c_compute_int "$LINENO" "sizeof(wchar_t) == sizeof(long double)" "HTYPE_IS_LDOUBLE"        "+#include <stdio.h>+#include <stddef.h>++#if HAVE_SYS_TYPES_H+# include <sys/types.h>+#endif++#if HAVE_UNISTD_H+# include <unistd.h>+#endif++#if HAVE_SYS_STAT_H+# include <sys/stat.h>+#endif++#if HAVE_FCNTL_H+# include <fcntl.h>+#endif++#if HAVE_SIGNAL_H+# include <signal.h>+#endif++#if HAVE_TIME_H+# include <time.h>+#endif++#if HAVE_TERMIOS_H+# include <termios.h>+#endif++#if HAVE_STRING_H+# include <string.h>+#endif++#if HAVE_CTYPE_H+# include <ctype.h>+#endif++#if HAVE_INTTYPES_H+# include <inttypes.h>+#else+# if HAVE_STDINT_H+#  include <stdint.h>+# endif+#endif++#if HAVE_SYS_RESOURCE_H+# include <sys/resource.h>+#endif++#include <stdlib.h>+"; then :++else+  fptools_cv_htype_sup_wchar_t=no+fi+++                if test "$HTYPE_IS_FLOAT" -eq 1+                then+                    fptools_cv_htype_wchar_t=Float+                elif test "$HTYPE_IS_DOUBLE" -eq 1+                then+                    fptools_cv_htype_wchar_t=Double+                elif test "$HTYPE_IS_LDOUBLE" -eq 1+                then+                    fptools_cv_htype_wchar_t=LDouble+                else+                    fptools_cv_htype_sup_wchar_t=no+                fi+            else+                if ac_fn_c_compute_int "$LINENO" "((wchar_t)(-1)) < ((wchar_t)0)" "HTYPE_IS_SIGNED"        "+#include <stdio.h>+#include <stddef.h>++#if HAVE_SYS_TYPES_H+# include <sys/types.h>+#endif++#if HAVE_UNISTD_H+# include <unistd.h>+#endif++#if HAVE_SYS_STAT_H+# include <sys/stat.h>+#endif++#if HAVE_FCNTL_H+# include <fcntl.h>+#endif++#if HAVE_SIGNAL_H+# include <signal.h>+#endif++#if HAVE_TIME_H+# include <time.h>+#endif++#if HAVE_TERMIOS_H+# include <termios.h>+#endif++#if HAVE_STRING_H+# include <string.h>+#endif++#if HAVE_CTYPE_H+# include <ctype.h>+#endif++#if HAVE_INTTYPES_H+# include <inttypes.h>+#else+# if HAVE_STDINT_H+#  include <stdint.h>+# endif+#endif++#if HAVE_SYS_RESOURCE_H+# include <sys/resource.h>+#endif++#include <stdlib.h>+"; then :++else+  fptools_cv_htype_sup_wchar_t=no+fi+++                if ac_fn_c_compute_int "$LINENO" "sizeof(wchar_t) * 8" "HTYPE_SIZE"        "+#include <stdio.h>+#include <stddef.h>++#if HAVE_SYS_TYPES_H+# include <sys/types.h>+#endif++#if HAVE_UNISTD_H+# include <unistd.h>+#endif++#if HAVE_SYS_STAT_H+# include <sys/stat.h>+#endif++#if HAVE_FCNTL_H+# include <fcntl.h>+#endif++#if HAVE_SIGNAL_H+# include <signal.h>+#endif++#if HAVE_TIME_H+# include <time.h>+#endif++#if HAVE_TERMIOS_H+# include <termios.h>+#endif++#if HAVE_STRING_H+# include <string.h>+#endif++#if HAVE_CTYPE_H+# include <ctype.h>+#endif++#if HAVE_INTTYPES_H+# include <inttypes.h>+#else+# if HAVE_STDINT_H+#  include <stdint.h>+# endif+#endif++#if HAVE_SYS_RESOURCE_H+# include <sys/resource.h>+#endif++#include <stdlib.h>+"; then :++else+  fptools_cv_htype_sup_wchar_t=no+fi+++                if test "$HTYPE_IS_SIGNED" -eq 0+                then+                    fptools_cv_htype_wchar_t="Word$HTYPE_SIZE"+                else+                    fptools_cv_htype_wchar_t="Int$HTYPE_SIZE"+                fi+            fi+        fi++fi++    if test "$fptools_cv_htype_sup_wchar_t" = no+    then++        fptools_cv_htype_wchar_t=NotReallyAType+        { $as_echo "$as_me:${as_lineno-$LINENO}: result: not supported" >&5+$as_echo "not supported" >&6; }++    fi++            if test "$fptools_cv_htype_sup_wchar_t" = yes; then+        { $as_echo "$as_me:${as_lineno-$LINENO}: result: $fptools_cv_htype_wchar_t" >&5+$as_echo "$fptools_cv_htype_wchar_t" >&6; }++cat >>confdefs.h <<_ACEOF+#define HTYPE_WCHAR_T $fptools_cv_htype_wchar_t+_ACEOF++    fi+++++++++++    { $as_echo "$as_me:${as_lineno-$LINENO}: checking Haskell type for sig_atomic_t" >&5+$as_echo_n "checking Haskell type for sig_atomic_t... " >&6; }+    if test "${fptools_cv_htype_sig_atomic_t+set}" = set; then :+  $as_echo_n "(cached) " >&6+else++        fptools_cv_htype_sup_sig_atomic_t=yes+        if ac_fn_c_compute_int "$LINENO" "((sig_atomic_t)((int)((sig_atomic_t)1.4))) == ((sig_atomic_t)1.4)" "HTYPE_IS_INTEGRAL"        "+#include <stdio.h>+#include <stddef.h>++#if HAVE_SYS_TYPES_H+# include <sys/types.h>+#endif++#if HAVE_UNISTD_H+# include <unistd.h>+#endif++#if HAVE_SYS_STAT_H+# include <sys/stat.h>+#endif++#if HAVE_FCNTL_H+# include <fcntl.h>+#endif++#if HAVE_SIGNAL_H+# include <signal.h>+#endif++#if HAVE_TIME_H+# include <time.h>+#endif++#if HAVE_TERMIOS_H+# include <termios.h>+#endif++#if HAVE_STRING_H+# include <string.h>+#endif++#if HAVE_CTYPE_H+# include <ctype.h>+#endif++#if HAVE_INTTYPES_H+# include <inttypes.h>+#else+# if HAVE_STDINT_H+#  include <stdint.h>+# endif+#endif++#if HAVE_SYS_RESOURCE_H+# include <sys/resource.h>+#endif++#include <stdlib.h>+"; then :++else+  fptools_cv_htype_sup_sig_atomic_t=no+fi+++        if test "$fptools_cv_htype_sup_sig_atomic_t" = "yes"+        then+            if test "$HTYPE_IS_INTEGRAL" -eq 0+            then+                if ac_fn_c_compute_int "$LINENO" "sizeof(sig_atomic_t) == sizeof(float)" "HTYPE_IS_FLOAT"        "+#include <stdio.h>+#include <stddef.h>++#if HAVE_SYS_TYPES_H+# include <sys/types.h>+#endif++#if HAVE_UNISTD_H+# include <unistd.h>+#endif++#if HAVE_SYS_STAT_H+# include <sys/stat.h>+#endif++#if HAVE_FCNTL_H+# include <fcntl.h>+#endif++#if HAVE_SIGNAL_H+# include <signal.h>+#endif++#if HAVE_TIME_H+# include <time.h>+#endif++#if HAVE_TERMIOS_H+# include <termios.h>+#endif++#if HAVE_STRING_H+# include <string.h>+#endif++#if HAVE_CTYPE_H+# include <ctype.h>+#endif++#if HAVE_INTTYPES_H+# include <inttypes.h>+#else+# if HAVE_STDINT_H+#  include <stdint.h>+# endif+#endif++#if HAVE_SYS_RESOURCE_H+# include <sys/resource.h>+#endif++#include <stdlib.h>+"; then :++else+  fptools_cv_htype_sup_sig_atomic_t=no+fi+++                if ac_fn_c_compute_int "$LINENO" "sizeof(sig_atomic_t) == sizeof(double)" "HTYPE_IS_DOUBLE"        "+#include <stdio.h>+#include <stddef.h>++#if HAVE_SYS_TYPES_H+# include <sys/types.h>+#endif++#if HAVE_UNISTD_H+# include <unistd.h>+#endif++#if HAVE_SYS_STAT_H+# include <sys/stat.h>+#endif++#if HAVE_FCNTL_H+# include <fcntl.h>+#endif++#if HAVE_SIGNAL_H+# include <signal.h>+#endif++#if HAVE_TIME_H+# include <time.h>+#endif++#if HAVE_TERMIOS_H+# include <termios.h>+#endif++#if HAVE_STRING_H+# include <string.h>+#endif++#if HAVE_CTYPE_H+# include <ctype.h>+#endif++#if HAVE_INTTYPES_H+# include <inttypes.h>+#else+# if HAVE_STDINT_H+#  include <stdint.h>+# endif+#endif++#if HAVE_SYS_RESOURCE_H+# include <sys/resource.h>+#endif++#include <stdlib.h>+"; then :++else+  fptools_cv_htype_sup_sig_atomic_t=no+fi+++                if ac_fn_c_compute_int "$LINENO" "sizeof(sig_atomic_t) == sizeof(long double)" "HTYPE_IS_LDOUBLE"        "+#include <stdio.h>+#include <stddef.h>++#if HAVE_SYS_TYPES_H+# include <sys/types.h>+#endif++#if HAVE_UNISTD_H+# include <unistd.h>+#endif++#if HAVE_SYS_STAT_H+# include <sys/stat.h>+#endif++#if HAVE_FCNTL_H+# include <fcntl.h>+#endif++#if HAVE_SIGNAL_H+# include <signal.h>+#endif++#if HAVE_TIME_H+# include <time.h>+#endif++#if HAVE_TERMIOS_H+# include <termios.h>+#endif++#if HAVE_STRING_H+# include <string.h>+#endif++#if HAVE_CTYPE_H+# include <ctype.h>+#endif++#if HAVE_INTTYPES_H+# include <inttypes.h>+#else+# if HAVE_STDINT_H+#  include <stdint.h>+# endif+#endif++#if HAVE_SYS_RESOURCE_H+# include <sys/resource.h>+#endif++#include <stdlib.h>+"; then :++else+  fptools_cv_htype_sup_sig_atomic_t=no+fi+++                if test "$HTYPE_IS_FLOAT" -eq 1+                then+                    fptools_cv_htype_sig_atomic_t=Float+                elif test "$HTYPE_IS_DOUBLE" -eq 1+                then+                    fptools_cv_htype_sig_atomic_t=Double+                elif test "$HTYPE_IS_LDOUBLE" -eq 1+                then+                    fptools_cv_htype_sig_atomic_t=LDouble+                else+                    fptools_cv_htype_sup_sig_atomic_t=no+                fi+            else+                if ac_fn_c_compute_int "$LINENO" "((sig_atomic_t)(-1)) < ((sig_atomic_t)0)" "HTYPE_IS_SIGNED"        "+#include <stdio.h>+#include <stddef.h>++#if HAVE_SYS_TYPES_H+# include <sys/types.h>+#endif++#if HAVE_UNISTD_H+# include <unistd.h>+#endif++#if HAVE_SYS_STAT_H+# include <sys/stat.h>+#endif++#if HAVE_FCNTL_H+# include <fcntl.h>+#endif++#if HAVE_SIGNAL_H+# include <signal.h>+#endif++#if HAVE_TIME_H+# include <time.h>+#endif++#if HAVE_TERMIOS_H+# include <termios.h>+#endif++#if HAVE_STRING_H+# include <string.h>+#endif++#if HAVE_CTYPE_H+# include <ctype.h>+#endif++#if HAVE_INTTYPES_H+# include <inttypes.h>+#else+# if HAVE_STDINT_H+#  include <stdint.h>+# endif+#endif++#if HAVE_SYS_RESOURCE_H+# include <sys/resource.h>+#endif++#include <stdlib.h>+"; then :++else+  fptools_cv_htype_sup_sig_atomic_t=no+fi+++                if ac_fn_c_compute_int "$LINENO" "sizeof(sig_atomic_t) * 8" "HTYPE_SIZE"        "+#include <stdio.h>+#include <stddef.h>++#if HAVE_SYS_TYPES_H+# include <sys/types.h>+#endif++#if HAVE_UNISTD_H+# include <unistd.h>+#endif++#if HAVE_SYS_STAT_H+# include <sys/stat.h>+#endif++#if HAVE_FCNTL_H+# include <fcntl.h>+#endif++#if HAVE_SIGNAL_H+# include <signal.h>+#endif++#if HAVE_TIME_H+# include <time.h>+#endif++#if HAVE_TERMIOS_H+# include <termios.h>+#endif++#if HAVE_STRING_H+# include <string.h>+#endif++#if HAVE_CTYPE_H+# include <ctype.h>+#endif++#if HAVE_INTTYPES_H+# include <inttypes.h>+#else+# if HAVE_STDINT_H+#  include <stdint.h>+# endif+#endif++#if HAVE_SYS_RESOURCE_H+# include <sys/resource.h>+#endif++#include <stdlib.h>+"; then :++else+  fptools_cv_htype_sup_sig_atomic_t=no+fi+++                if test "$HTYPE_IS_SIGNED" -eq 0+                then+                    fptools_cv_htype_sig_atomic_t="Word$HTYPE_SIZE"+                else+                    fptools_cv_htype_sig_atomic_t="Int$HTYPE_SIZE"+                fi+            fi+        fi++fi++    if test "$fptools_cv_htype_sup_sig_atomic_t" = no+    then++        fptools_cv_htype_sig_atomic_t=NotReallyAType+        { $as_echo "$as_me:${as_lineno-$LINENO}: result: not supported" >&5+$as_echo "not supported" >&6; }++    fi++            if test "$fptools_cv_htype_sup_sig_atomic_t" = yes; then+        { $as_echo "$as_me:${as_lineno-$LINENO}: result: $fptools_cv_htype_sig_atomic_t" >&5+$as_echo "$fptools_cv_htype_sig_atomic_t" >&6; }++cat >>confdefs.h <<_ACEOF+#define HTYPE_SIG_ATOMIC_T $fptools_cv_htype_sig_atomic_t+_ACEOF++    fi+++++++++++    { $as_echo "$as_me:${as_lineno-$LINENO}: checking Haskell type for clock_t" >&5+$as_echo_n "checking Haskell type for clock_t... " >&6; }+    if test "${fptools_cv_htype_clock_t+set}" = set; then :+  $as_echo_n "(cached) " >&6+else++        fptools_cv_htype_sup_clock_t=yes+        if ac_fn_c_compute_int "$LINENO" "((clock_t)((int)((clock_t)1.4))) == ((clock_t)1.4)" "HTYPE_IS_INTEGRAL"        "+#include <stdio.h>+#include <stddef.h>++#if HAVE_SYS_TYPES_H+# include <sys/types.h>+#endif++#if HAVE_UNISTD_H+# include <unistd.h>+#endif++#if HAVE_SYS_STAT_H+# include <sys/stat.h>+#endif++#if HAVE_FCNTL_H+# include <fcntl.h>+#endif++#if HAVE_SIGNAL_H+# include <signal.h>+#endif++#if HAVE_TIME_H+# include <time.h>+#endif++#if HAVE_TERMIOS_H+# include <termios.h>+#endif++#if HAVE_STRING_H+# include <string.h>+#endif++#if HAVE_CTYPE_H+# include <ctype.h>+#endif++#if HAVE_INTTYPES_H+# include <inttypes.h>+#else+# if HAVE_STDINT_H+#  include <stdint.h>+# endif+#endif++#if HAVE_SYS_RESOURCE_H+# include <sys/resource.h>+#endif++#include <stdlib.h>+"; then :++else+  fptools_cv_htype_sup_clock_t=no+fi+++        if test "$fptools_cv_htype_sup_clock_t" = "yes"+        then+            if test "$HTYPE_IS_INTEGRAL" -eq 0+            then+                if ac_fn_c_compute_int "$LINENO" "sizeof(clock_t) == sizeof(float)" "HTYPE_IS_FLOAT"        "+#include <stdio.h>+#include <stddef.h>++#if HAVE_SYS_TYPES_H+# include <sys/types.h>+#endif++#if HAVE_UNISTD_H+# include <unistd.h>+#endif++#if HAVE_SYS_STAT_H+# include <sys/stat.h>+#endif++#if HAVE_FCNTL_H+# include <fcntl.h>+#endif++#if HAVE_SIGNAL_H+# include <signal.h>+#endif++#if HAVE_TIME_H+# include <time.h>+#endif++#if HAVE_TERMIOS_H+# include <termios.h>+#endif++#if HAVE_STRING_H+# include <string.h>+#endif++#if HAVE_CTYPE_H+# include <ctype.h>+#endif++#if HAVE_INTTYPES_H+# include <inttypes.h>+#else+# if HAVE_STDINT_H+#  include <stdint.h>+# endif+#endif++#if HAVE_SYS_RESOURCE_H+# include <sys/resource.h>+#endif++#include <stdlib.h>+"; then :++else+  fptools_cv_htype_sup_clock_t=no+fi+++                if ac_fn_c_compute_int "$LINENO" "sizeof(clock_t) == sizeof(double)" "HTYPE_IS_DOUBLE"        "+#include <stdio.h>+#include <stddef.h>++#if HAVE_SYS_TYPES_H+# include <sys/types.h>+#endif++#if HAVE_UNISTD_H+# include <unistd.h>+#endif++#if HAVE_SYS_STAT_H+# include <sys/stat.h>+#endif++#if HAVE_FCNTL_H+# include <fcntl.h>+#endif++#if HAVE_SIGNAL_H+# include <signal.h>+#endif++#if HAVE_TIME_H+# include <time.h>+#endif++#if HAVE_TERMIOS_H+# include <termios.h>+#endif++#if HAVE_STRING_H+# include <string.h>+#endif++#if HAVE_CTYPE_H+# include <ctype.h>+#endif++#if HAVE_INTTYPES_H+# include <inttypes.h>+#else+# if HAVE_STDINT_H+#  include <stdint.h>+# endif+#endif++#if HAVE_SYS_RESOURCE_H+# include <sys/resource.h>+#endif++#include <stdlib.h>+"; then :++else+  fptools_cv_htype_sup_clock_t=no+fi+++                if ac_fn_c_compute_int "$LINENO" "sizeof(clock_t) == sizeof(long double)" "HTYPE_IS_LDOUBLE"        "+#include <stdio.h>+#include <stddef.h>++#if HAVE_SYS_TYPES_H+# include <sys/types.h>+#endif++#if HAVE_UNISTD_H+# include <unistd.h>+#endif++#if HAVE_SYS_STAT_H+# include <sys/stat.h>+#endif++#if HAVE_FCNTL_H+# include <fcntl.h>+#endif++#if HAVE_SIGNAL_H+# include <signal.h>+#endif++#if HAVE_TIME_H+# include <time.h>+#endif++#if HAVE_TERMIOS_H+# include <termios.h>+#endif++#if HAVE_STRING_H+# include <string.h>+#endif++#if HAVE_CTYPE_H+# include <ctype.h>+#endif++#if HAVE_INTTYPES_H+# include <inttypes.h>+#else+# if HAVE_STDINT_H+#  include <stdint.h>+# endif+#endif++#if HAVE_SYS_RESOURCE_H+# include <sys/resource.h>+#endif++#include <stdlib.h>+"; then :++else+  fptools_cv_htype_sup_clock_t=no+fi+++                if test "$HTYPE_IS_FLOAT" -eq 1+                then+                    fptools_cv_htype_clock_t=Float+                elif test "$HTYPE_IS_DOUBLE" -eq 1+                then+                    fptools_cv_htype_clock_t=Double+                elif test "$HTYPE_IS_LDOUBLE" -eq 1+                then+                    fptools_cv_htype_clock_t=LDouble+                else+                    fptools_cv_htype_sup_clock_t=no+                fi+            else+                if ac_fn_c_compute_int "$LINENO" "((clock_t)(-1)) < ((clock_t)0)" "HTYPE_IS_SIGNED"        "+#include <stdio.h>+#include <stddef.h>++#if HAVE_SYS_TYPES_H+# include <sys/types.h>+#endif++#if HAVE_UNISTD_H+# include <unistd.h>+#endif++#if HAVE_SYS_STAT_H+# include <sys/stat.h>+#endif++#if HAVE_FCNTL_H+# include <fcntl.h>+#endif++#if HAVE_SIGNAL_H+# include <signal.h>+#endif++#if HAVE_TIME_H+# include <time.h>+#endif++#if HAVE_TERMIOS_H+# include <termios.h>+#endif++#if HAVE_STRING_H+# include <string.h>+#endif++#if HAVE_CTYPE_H+# include <ctype.h>+#endif++#if HAVE_INTTYPES_H+# include <inttypes.h>+#else+# if HAVE_STDINT_H+#  include <stdint.h>+# endif+#endif++#if HAVE_SYS_RESOURCE_H+# include <sys/resource.h>+#endif++#include <stdlib.h>+"; then :++else+  fptools_cv_htype_sup_clock_t=no+fi+++                if ac_fn_c_compute_int "$LINENO" "sizeof(clock_t) * 8" "HTYPE_SIZE"        "+#include <stdio.h>+#include <stddef.h>++#if HAVE_SYS_TYPES_H+# include <sys/types.h>+#endif++#if HAVE_UNISTD_H+# include <unistd.h>+#endif++#if HAVE_SYS_STAT_H+# include <sys/stat.h>+#endif++#if HAVE_FCNTL_H+# include <fcntl.h>+#endif++#if HAVE_SIGNAL_H+# include <signal.h>+#endif++#if HAVE_TIME_H+# include <time.h>+#endif++#if HAVE_TERMIOS_H+# include <termios.h>+#endif++#if HAVE_STRING_H+# include <string.h>+#endif++#if HAVE_CTYPE_H+# include <ctype.h>+#endif++#if HAVE_INTTYPES_H+# include <inttypes.h>+#else+# if HAVE_STDINT_H+#  include <stdint.h>+# endif+#endif++#if HAVE_SYS_RESOURCE_H+# include <sys/resource.h>+#endif++#include <stdlib.h>+"; then :++else+  fptools_cv_htype_sup_clock_t=no+fi+++                if test "$HTYPE_IS_SIGNED" -eq 0+                then+                    fptools_cv_htype_clock_t="Word$HTYPE_SIZE"+                else+                    fptools_cv_htype_clock_t="Int$HTYPE_SIZE"+                fi+            fi+        fi++fi++    if test "$fptools_cv_htype_sup_clock_t" = no+    then++        fptools_cv_htype_clock_t=NotReallyAType+        { $as_echo "$as_me:${as_lineno-$LINENO}: result: not supported" >&5+$as_echo "not supported" >&6; }++    fi++            if test "$fptools_cv_htype_sup_clock_t" = yes; then+        { $as_echo "$as_me:${as_lineno-$LINENO}: result: $fptools_cv_htype_clock_t" >&5+$as_echo "$fptools_cv_htype_clock_t" >&6; }++cat >>confdefs.h <<_ACEOF+#define HTYPE_CLOCK_T $fptools_cv_htype_clock_t+_ACEOF++    fi+++++++++++    { $as_echo "$as_me:${as_lineno-$LINENO}: checking Haskell type for time_t" >&5+$as_echo_n "checking Haskell type for time_t... " >&6; }+    if test "${fptools_cv_htype_time_t+set}" = set; then :+  $as_echo_n "(cached) " >&6+else++        fptools_cv_htype_sup_time_t=yes+        if ac_fn_c_compute_int "$LINENO" "((time_t)((int)((time_t)1.4))) == ((time_t)1.4)" "HTYPE_IS_INTEGRAL"        "+#include <stdio.h>+#include <stddef.h>++#if HAVE_SYS_TYPES_H+# include <sys/types.h>+#endif++#if HAVE_UNISTD_H+# include <unistd.h>+#endif++#if HAVE_SYS_STAT_H+# include <sys/stat.h>+#endif++#if HAVE_FCNTL_H+# include <fcntl.h>+#endif++#if HAVE_SIGNAL_H+# include <signal.h>+#endif++#if HAVE_TIME_H+# include <time.h>+#endif++#if HAVE_TERMIOS_H+# include <termios.h>+#endif++#if HAVE_STRING_H+# include <string.h>+#endif++#if HAVE_CTYPE_H+# include <ctype.h>+#endif++#if HAVE_INTTYPES_H+# include <inttypes.h>+#else+# if HAVE_STDINT_H+#  include <stdint.h>+# endif+#endif++#if HAVE_SYS_RESOURCE_H+# include <sys/resource.h>+#endif++#include <stdlib.h>+"; then :++else+  fptools_cv_htype_sup_time_t=no+fi+++        if test "$fptools_cv_htype_sup_time_t" = "yes"+        then+            if test "$HTYPE_IS_INTEGRAL" -eq 0+            then+                if ac_fn_c_compute_int "$LINENO" "sizeof(time_t) == sizeof(float)" "HTYPE_IS_FLOAT"        "+#include <stdio.h>+#include <stddef.h>++#if HAVE_SYS_TYPES_H+# include <sys/types.h>+#endif++#if HAVE_UNISTD_H+# include <unistd.h>+#endif++#if HAVE_SYS_STAT_H+# include <sys/stat.h>+#endif++#if HAVE_FCNTL_H+# include <fcntl.h>+#endif++#if HAVE_SIGNAL_H+# include <signal.h>+#endif++#if HAVE_TIME_H+# include <time.h>+#endif++#if HAVE_TERMIOS_H+# include <termios.h>+#endif++#if HAVE_STRING_H+# include <string.h>+#endif++#if HAVE_CTYPE_H+# include <ctype.h>+#endif++#if HAVE_INTTYPES_H+# include <inttypes.h>+#else+# if HAVE_STDINT_H+#  include <stdint.h>+# endif+#endif++#if HAVE_SYS_RESOURCE_H+# include <sys/resource.h>+#endif++#include <stdlib.h>+"; then :++else+  fptools_cv_htype_sup_time_t=no+fi+++                if ac_fn_c_compute_int "$LINENO" "sizeof(time_t) == sizeof(double)" "HTYPE_IS_DOUBLE"        "+#include <stdio.h>+#include <stddef.h>++#if HAVE_SYS_TYPES_H+# include <sys/types.h>+#endif++#if HAVE_UNISTD_H+# include <unistd.h>+#endif++#if HAVE_SYS_STAT_H+# include <sys/stat.h>+#endif++#if HAVE_FCNTL_H+# include <fcntl.h>+#endif++#if HAVE_SIGNAL_H+# include <signal.h>+#endif++#if HAVE_TIME_H+# include <time.h>+#endif++#if HAVE_TERMIOS_H+# include <termios.h>+#endif++#if HAVE_STRING_H+# include <string.h>+#endif++#if HAVE_CTYPE_H+# include <ctype.h>+#endif++#if HAVE_INTTYPES_H+# include <inttypes.h>+#else+# if HAVE_STDINT_H+#  include <stdint.h>+# endif+#endif++#if HAVE_SYS_RESOURCE_H+# include <sys/resource.h>+#endif++#include <stdlib.h>+"; then :++else+  fptools_cv_htype_sup_time_t=no+fi+++                if ac_fn_c_compute_int "$LINENO" "sizeof(time_t) == sizeof(long double)" "HTYPE_IS_LDOUBLE"        "+#include <stdio.h>+#include <stddef.h>++#if HAVE_SYS_TYPES_H+# include <sys/types.h>+#endif++#if HAVE_UNISTD_H+# include <unistd.h>+#endif++#if HAVE_SYS_STAT_H+# include <sys/stat.h>+#endif++#if HAVE_FCNTL_H+# include <fcntl.h>+#endif++#if HAVE_SIGNAL_H+# include <signal.h>+#endif++#if HAVE_TIME_H+# include <time.h>+#endif++#if HAVE_TERMIOS_H+# include <termios.h>+#endif++#if HAVE_STRING_H+# include <string.h>+#endif++#if HAVE_CTYPE_H+# include <ctype.h>+#endif++#if HAVE_INTTYPES_H+# include <inttypes.h>+#else+# if HAVE_STDINT_H+#  include <stdint.h>+# endif+#endif++#if HAVE_SYS_RESOURCE_H+# include <sys/resource.h>+#endif++#include <stdlib.h>+"; then :++else+  fptools_cv_htype_sup_time_t=no+fi+++                if test "$HTYPE_IS_FLOAT" -eq 1+                then+                    fptools_cv_htype_time_t=Float+                elif test "$HTYPE_IS_DOUBLE" -eq 1+                then+                    fptools_cv_htype_time_t=Double+                elif test "$HTYPE_IS_LDOUBLE" -eq 1+                then+                    fptools_cv_htype_time_t=LDouble+                else+                    fptools_cv_htype_sup_time_t=no+                fi+            else+                if ac_fn_c_compute_int "$LINENO" "((time_t)(-1)) < ((time_t)0)" "HTYPE_IS_SIGNED"        "+#include <stdio.h>+#include <stddef.h>++#if HAVE_SYS_TYPES_H+# include <sys/types.h>+#endif++#if HAVE_UNISTD_H+# include <unistd.h>+#endif++#if HAVE_SYS_STAT_H+# include <sys/stat.h>+#endif++#if HAVE_FCNTL_H+# include <fcntl.h>+#endif++#if HAVE_SIGNAL_H+# include <signal.h>+#endif++#if HAVE_TIME_H+# include <time.h>+#endif++#if HAVE_TERMIOS_H+# include <termios.h>+#endif++#if HAVE_STRING_H+# include <string.h>+#endif++#if HAVE_CTYPE_H+# include <ctype.h>+#endif++#if HAVE_INTTYPES_H+# include <inttypes.h>+#else+# if HAVE_STDINT_H+#  include <stdint.h>+# endif+#endif++#if HAVE_SYS_RESOURCE_H+# include <sys/resource.h>+#endif++#include <stdlib.h>+"; then :++else+  fptools_cv_htype_sup_time_t=no+fi+++                if ac_fn_c_compute_int "$LINENO" "sizeof(time_t) * 8" "HTYPE_SIZE"        "+#include <stdio.h>+#include <stddef.h>++#if HAVE_SYS_TYPES_H+# include <sys/types.h>+#endif++#if HAVE_UNISTD_H+# include <unistd.h>+#endif++#if HAVE_SYS_STAT_H+# include <sys/stat.h>+#endif++#if HAVE_FCNTL_H+# include <fcntl.h>+#endif++#if HAVE_SIGNAL_H+# include <signal.h>+#endif++#if HAVE_TIME_H+# include <time.h>+#endif++#if HAVE_TERMIOS_H+# include <termios.h>+#endif++#if HAVE_STRING_H+# include <string.h>+#endif++#if HAVE_CTYPE_H+# include <ctype.h>+#endif++#if HAVE_INTTYPES_H+# include <inttypes.h>+#else+# if HAVE_STDINT_H+#  include <stdint.h>+# endif+#endif++#if HAVE_SYS_RESOURCE_H+# include <sys/resource.h>+#endif++#include <stdlib.h>+"; then :++else+  fptools_cv_htype_sup_time_t=no+fi+++                if test "$HTYPE_IS_SIGNED" -eq 0+                then+                    fptools_cv_htype_time_t="Word$HTYPE_SIZE"+                else+                    fptools_cv_htype_time_t="Int$HTYPE_SIZE"+                fi+            fi+        fi++fi++    if test "$fptools_cv_htype_sup_time_t" = no+    then++        fptools_cv_htype_time_t=NotReallyAType+        { $as_echo "$as_me:${as_lineno-$LINENO}: result: not supported" >&5+$as_echo "not supported" >&6; }++    fi++            if test "$fptools_cv_htype_sup_time_t" = yes; then+        { $as_echo "$as_me:${as_lineno-$LINENO}: result: $fptools_cv_htype_time_t" >&5+$as_echo "$fptools_cv_htype_time_t" >&6; }++cat >>confdefs.h <<_ACEOF+#define HTYPE_TIME_T $fptools_cv_htype_time_t+_ACEOF++    fi+++++++++++    { $as_echo "$as_me:${as_lineno-$LINENO}: checking Haskell type for useconds_t" >&5+$as_echo_n "checking Haskell type for useconds_t... " >&6; }+    if test "${fptools_cv_htype_useconds_t+set}" = set; then :+  $as_echo_n "(cached) " >&6+else++        fptools_cv_htype_sup_useconds_t=yes+        if ac_fn_c_compute_int "$LINENO" "((useconds_t)((int)((useconds_t)1.4))) == ((useconds_t)1.4)" "HTYPE_IS_INTEGRAL"        "+#include <stdio.h>+#include <stddef.h>++#if HAVE_SYS_TYPES_H+# include <sys/types.h>+#endif++#if HAVE_UNISTD_H+# include <unistd.h>+#endif++#if HAVE_SYS_STAT_H+# include <sys/stat.h>+#endif++#if HAVE_FCNTL_H+# include <fcntl.h>+#endif++#if HAVE_SIGNAL_H+# include <signal.h>+#endif++#if HAVE_TIME_H+# include <time.h>+#endif++#if HAVE_TERMIOS_H+# include <termios.h>+#endif++#if HAVE_STRING_H+# include <string.h>+#endif++#if HAVE_CTYPE_H+# include <ctype.h>+#endif++#if HAVE_INTTYPES_H+# include <inttypes.h>+#else+# if HAVE_STDINT_H+#  include <stdint.h>+# endif+#endif++#if HAVE_SYS_RESOURCE_H+# include <sys/resource.h>+#endif++#include <stdlib.h>+"; then :++else+  fptools_cv_htype_sup_useconds_t=no+fi+++        if test "$fptools_cv_htype_sup_useconds_t" = "yes"+        then+            if test "$HTYPE_IS_INTEGRAL" -eq 0+            then+                if ac_fn_c_compute_int "$LINENO" "sizeof(useconds_t) == sizeof(float)" "HTYPE_IS_FLOAT"        "+#include <stdio.h>+#include <stddef.h>++#if HAVE_SYS_TYPES_H+# include <sys/types.h>+#endif++#if HAVE_UNISTD_H+# include <unistd.h>+#endif++#if HAVE_SYS_STAT_H+# include <sys/stat.h>+#endif++#if HAVE_FCNTL_H+# include <fcntl.h>+#endif++#if HAVE_SIGNAL_H+# include <signal.h>+#endif++#if HAVE_TIME_H+# include <time.h>+#endif++#if HAVE_TERMIOS_H+# include <termios.h>+#endif++#if HAVE_STRING_H+# include <string.h>+#endif++#if HAVE_CTYPE_H+# include <ctype.h>+#endif++#if HAVE_INTTYPES_H+# include <inttypes.h>+#else+# if HAVE_STDINT_H+#  include <stdint.h>+# endif+#endif++#if HAVE_SYS_RESOURCE_H+# include <sys/resource.h>+#endif++#include <stdlib.h>+"; then :++else+  fptools_cv_htype_sup_useconds_t=no+fi+++                if ac_fn_c_compute_int "$LINENO" "sizeof(useconds_t) == sizeof(double)" "HTYPE_IS_DOUBLE"        "+#include <stdio.h>+#include <stddef.h>++#if HAVE_SYS_TYPES_H+# include <sys/types.h>+#endif++#if HAVE_UNISTD_H+# include <unistd.h>+#endif++#if HAVE_SYS_STAT_H+# include <sys/stat.h>+#endif++#if HAVE_FCNTL_H+# include <fcntl.h>+#endif++#if HAVE_SIGNAL_H+# include <signal.h>+#endif++#if HAVE_TIME_H+# include <time.h>+#endif++#if HAVE_TERMIOS_H+# include <termios.h>+#endif++#if HAVE_STRING_H+# include <string.h>+#endif++#if HAVE_CTYPE_H+# include <ctype.h>+#endif++#if HAVE_INTTYPES_H+# include <inttypes.h>+#else+# if HAVE_STDINT_H+#  include <stdint.h>+# endif+#endif++#if HAVE_SYS_RESOURCE_H+# include <sys/resource.h>+#endif++#include <stdlib.h>+"; then :++else+  fptools_cv_htype_sup_useconds_t=no+fi+++                if ac_fn_c_compute_int "$LINENO" "sizeof(useconds_t) == sizeof(long double)" "HTYPE_IS_LDOUBLE"        "+#include <stdio.h>+#include <stddef.h>++#if HAVE_SYS_TYPES_H+# include <sys/types.h>+#endif++#if HAVE_UNISTD_H+# include <unistd.h>+#endif++#if HAVE_SYS_STAT_H+# include <sys/stat.h>+#endif++#if HAVE_FCNTL_H+# include <fcntl.h>+#endif++#if HAVE_SIGNAL_H+# include <signal.h>+#endif++#if HAVE_TIME_H+# include <time.h>+#endif++#if HAVE_TERMIOS_H+# include <termios.h>+#endif++#if HAVE_STRING_H+# include <string.h>+#endif++#if HAVE_CTYPE_H+# include <ctype.h>+#endif++#if HAVE_INTTYPES_H+# include <inttypes.h>+#else+# if HAVE_STDINT_H+#  include <stdint.h>+# endif+#endif++#if HAVE_SYS_RESOURCE_H+# include <sys/resource.h>+#endif++#include <stdlib.h>+"; then :++else+  fptools_cv_htype_sup_useconds_t=no+fi+++                if test "$HTYPE_IS_FLOAT" -eq 1+                then+                    fptools_cv_htype_useconds_t=Float+                elif test "$HTYPE_IS_DOUBLE" -eq 1+                then+                    fptools_cv_htype_useconds_t=Double+                elif test "$HTYPE_IS_LDOUBLE" -eq 1+                then+                    fptools_cv_htype_useconds_t=LDouble+                else+                    fptools_cv_htype_sup_useconds_t=no+                fi+            else+                if ac_fn_c_compute_int "$LINENO" "((useconds_t)(-1)) < ((useconds_t)0)" "HTYPE_IS_SIGNED"        "+#include <stdio.h>+#include <stddef.h>++#if HAVE_SYS_TYPES_H+# include <sys/types.h>+#endif++#if HAVE_UNISTD_H+# include <unistd.h>+#endif++#if HAVE_SYS_STAT_H+# include <sys/stat.h>+#endif++#if HAVE_FCNTL_H+# include <fcntl.h>+#endif++#if HAVE_SIGNAL_H+# include <signal.h>+#endif++#if HAVE_TIME_H+# include <time.h>+#endif++#if HAVE_TERMIOS_H+# include <termios.h>+#endif++#if HAVE_STRING_H+# include <string.h>+#endif++#if HAVE_CTYPE_H+# include <ctype.h>+#endif++#if HAVE_INTTYPES_H+# include <inttypes.h>+#else+# if HAVE_STDINT_H+#  include <stdint.h>+# endif+#endif++#if HAVE_SYS_RESOURCE_H+# include <sys/resource.h>+#endif++#include <stdlib.h>+"; then :++else+  fptools_cv_htype_sup_useconds_t=no+fi+++                if ac_fn_c_compute_int "$LINENO" "sizeof(useconds_t) * 8" "HTYPE_SIZE"        "+#include <stdio.h>+#include <stddef.h>++#if HAVE_SYS_TYPES_H+# include <sys/types.h>+#endif++#if HAVE_UNISTD_H+# include <unistd.h>+#endif++#if HAVE_SYS_STAT_H+# include <sys/stat.h>+#endif++#if HAVE_FCNTL_H+# include <fcntl.h>+#endif++#if HAVE_SIGNAL_H+# include <signal.h>+#endif++#if HAVE_TIME_H+# include <time.h>+#endif++#if HAVE_TERMIOS_H+# include <termios.h>+#endif++#if HAVE_STRING_H+# include <string.h>+#endif++#if HAVE_CTYPE_H+# include <ctype.h>+#endif++#if HAVE_INTTYPES_H+# include <inttypes.h>+#else+# if HAVE_STDINT_H+#  include <stdint.h>+# endif+#endif++#if HAVE_SYS_RESOURCE_H+# include <sys/resource.h>+#endif++#include <stdlib.h>+"; then :++else+  fptools_cv_htype_sup_useconds_t=no+fi+++                if test "$HTYPE_IS_SIGNED" -eq 0+                then+                    fptools_cv_htype_useconds_t="Word$HTYPE_SIZE"+                else+                    fptools_cv_htype_useconds_t="Int$HTYPE_SIZE"+                fi+            fi+        fi++fi++    if test "$fptools_cv_htype_sup_useconds_t" = no+    then++        fptools_cv_htype_useconds_t=NotReallyAType+        { $as_echo "$as_me:${as_lineno-$LINENO}: result: not supported" >&5+$as_echo "not supported" >&6; }++    fi++            if test "$fptools_cv_htype_sup_useconds_t" = yes; then+        { $as_echo "$as_me:${as_lineno-$LINENO}: result: $fptools_cv_htype_useconds_t" >&5+$as_echo "$fptools_cv_htype_useconds_t" >&6; }++cat >>confdefs.h <<_ACEOF+#define HTYPE_USECONDS_T $fptools_cv_htype_useconds_t+_ACEOF++    fi++++++++++    { $as_echo "$as_me:${as_lineno-$LINENO}: checking Haskell type for suseconds_t" >&5+$as_echo_n "checking Haskell type for suseconds_t... " >&6; }+    if test "${fptools_cv_htype_suseconds_t+set}" = set; then :+  $as_echo_n "(cached) " >&6+else++        fptools_cv_htype_sup_suseconds_t=yes+        if ac_fn_c_compute_int "$LINENO" "((suseconds_t)((int)((suseconds_t)1.4))) == ((suseconds_t)1.4)" "HTYPE_IS_INTEGRAL"        "+#include <stdio.h>+#include <stddef.h>++#if HAVE_SYS_TYPES_H+# include <sys/types.h>+#endif++#if HAVE_UNISTD_H+# include <unistd.h>+#endif++#if HAVE_SYS_STAT_H+# include <sys/stat.h>+#endif++#if HAVE_FCNTL_H+# include <fcntl.h>+#endif++#if HAVE_SIGNAL_H+# include <signal.h>+#endif++#if HAVE_TIME_H+# include <time.h>+#endif++#if HAVE_TERMIOS_H+# include <termios.h>+#endif++#if HAVE_STRING_H+# include <string.h>+#endif++#if HAVE_CTYPE_H+# include <ctype.h>+#endif++#if HAVE_INTTYPES_H+# include <inttypes.h>+#else+# if HAVE_STDINT_H+#  include <stdint.h>+# endif+#endif++#if HAVE_SYS_RESOURCE_H+# include <sys/resource.h>+#endif++#include <stdlib.h>+"; then :++else+  fptools_cv_htype_sup_suseconds_t=no+fi+++        if test "$fptools_cv_htype_sup_suseconds_t" = "yes"+        then+            if test "$HTYPE_IS_INTEGRAL" -eq 0+            then+                if ac_fn_c_compute_int "$LINENO" "sizeof(suseconds_t) == sizeof(float)" "HTYPE_IS_FLOAT"        "+#include <stdio.h>+#include <stddef.h>++#if HAVE_SYS_TYPES_H+# include <sys/types.h>+#endif++#if HAVE_UNISTD_H+# include <unistd.h>+#endif++#if HAVE_SYS_STAT_H+# include <sys/stat.h>+#endif++#if HAVE_FCNTL_H+# include <fcntl.h>+#endif++#if HAVE_SIGNAL_H+# include <signal.h>+#endif++#if HAVE_TIME_H+# include <time.h>+#endif++#if HAVE_TERMIOS_H+# include <termios.h>+#endif++#if HAVE_STRING_H+# include <string.h>+#endif++#if HAVE_CTYPE_H+# include <ctype.h>+#endif++#if HAVE_INTTYPES_H+# include <inttypes.h>+#else+# if HAVE_STDINT_H+#  include <stdint.h>+# endif+#endif++#if HAVE_SYS_RESOURCE_H+# include <sys/resource.h>+#endif++#include <stdlib.h>+"; then :++else+  fptools_cv_htype_sup_suseconds_t=no+fi+++                if ac_fn_c_compute_int "$LINENO" "sizeof(suseconds_t) == sizeof(double)" "HTYPE_IS_DOUBLE"        "+#include <stdio.h>+#include <stddef.h>++#if HAVE_SYS_TYPES_H+# include <sys/types.h>+#endif++#if HAVE_UNISTD_H+# include <unistd.h>+#endif++#if HAVE_SYS_STAT_H+# include <sys/stat.h>+#endif++#if HAVE_FCNTL_H+# include <fcntl.h>+#endif++#if HAVE_SIGNAL_H+# include <signal.h>+#endif++#if HAVE_TIME_H+# include <time.h>+#endif++#if HAVE_TERMIOS_H+# include <termios.h>+#endif++#if HAVE_STRING_H+# include <string.h>+#endif++#if HAVE_CTYPE_H+# include <ctype.h>+#endif++#if HAVE_INTTYPES_H+# include <inttypes.h>+#else+# if HAVE_STDINT_H+#  include <stdint.h>+# endif+#endif++#if HAVE_SYS_RESOURCE_H+# include <sys/resource.h>+#endif++#include <stdlib.h>+"; then :++else+  fptools_cv_htype_sup_suseconds_t=no+fi+++                if ac_fn_c_compute_int "$LINENO" "sizeof(suseconds_t) == sizeof(long double)" "HTYPE_IS_LDOUBLE"        "+#include <stdio.h>+#include <stddef.h>++#if HAVE_SYS_TYPES_H+# include <sys/types.h>+#endif++#if HAVE_UNISTD_H+# include <unistd.h>+#endif++#if HAVE_SYS_STAT_H+# include <sys/stat.h>+#endif++#if HAVE_FCNTL_H+# include <fcntl.h>+#endif++#if HAVE_SIGNAL_H+# include <signal.h>+#endif++#if HAVE_TIME_H+# include <time.h>+#endif++#if HAVE_TERMIOS_H+# include <termios.h>+#endif++#if HAVE_STRING_H+# include <string.h>+#endif++#if HAVE_CTYPE_H+# include <ctype.h>+#endif++#if HAVE_INTTYPES_H+# include <inttypes.h>+#else+# if HAVE_STDINT_H+#  include <stdint.h>+# endif+#endif++#if HAVE_SYS_RESOURCE_H+# include <sys/resource.h>+#endif++#include <stdlib.h>+"; then :++else+  fptools_cv_htype_sup_suseconds_t=no+fi+++                if test "$HTYPE_IS_FLOAT" -eq 1+                then+                    fptools_cv_htype_suseconds_t=Float+                elif test "$HTYPE_IS_DOUBLE" -eq 1+                then+                    fptools_cv_htype_suseconds_t=Double+                elif test "$HTYPE_IS_LDOUBLE" -eq 1+                then+                    fptools_cv_htype_suseconds_t=LDouble+                else+                    fptools_cv_htype_sup_suseconds_t=no+                fi+            else+                if ac_fn_c_compute_int "$LINENO" "((suseconds_t)(-1)) < ((suseconds_t)0)" "HTYPE_IS_SIGNED"        "+#include <stdio.h>+#include <stddef.h>++#if HAVE_SYS_TYPES_H+# include <sys/types.h>+#endif++#if HAVE_UNISTD_H+# include <unistd.h>+#endif++#if HAVE_SYS_STAT_H+# include <sys/stat.h>+#endif++#if HAVE_FCNTL_H+# include <fcntl.h>+#endif++#if HAVE_SIGNAL_H+# include <signal.h>+#endif++#if HAVE_TIME_H+# include <time.h>+#endif++#if HAVE_TERMIOS_H+# include <termios.h>+#endif++#if HAVE_STRING_H+# include <string.h>+#endif++#if HAVE_CTYPE_H+# include <ctype.h>+#endif++#if HAVE_INTTYPES_H+# include <inttypes.h>+#else+# if HAVE_STDINT_H+#  include <stdint.h>+# endif+#endif++#if HAVE_SYS_RESOURCE_H+# include <sys/resource.h>+#endif++#include <stdlib.h>+"; then :++else+  fptools_cv_htype_sup_suseconds_t=no+fi+++                if ac_fn_c_compute_int "$LINENO" "sizeof(suseconds_t) * 8" "HTYPE_SIZE"        "+#include <stdio.h>+#include <stddef.h>++#if HAVE_SYS_TYPES_H+# include <sys/types.h>+#endif++#if HAVE_UNISTD_H+# include <unistd.h>+#endif++#if HAVE_SYS_STAT_H+# include <sys/stat.h>+#endif++#if HAVE_FCNTL_H+# include <fcntl.h>+#endif++#if HAVE_SIGNAL_H+# include <signal.h>+#endif++#if HAVE_TIME_H+# include <time.h>+#endif++#if HAVE_TERMIOS_H+# include <termios.h>+#endif++#if HAVE_STRING_H+# include <string.h>+#endif++#if HAVE_CTYPE_H+# include <ctype.h>+#endif++#if HAVE_INTTYPES_H+# include <inttypes.h>+#else+# if HAVE_STDINT_H+#  include <stdint.h>+# endif+#endif++#if HAVE_SYS_RESOURCE_H+# include <sys/resource.h>+#endif++#include <stdlib.h>+"; then :++else+  fptools_cv_htype_sup_suseconds_t=no+fi+++                if test "$HTYPE_IS_SIGNED" -eq 0+                then+                    fptools_cv_htype_suseconds_t="Word$HTYPE_SIZE"+                else+                    fptools_cv_htype_suseconds_t="Int$HTYPE_SIZE"+                fi+            fi+        fi++fi++    if test "$fptools_cv_htype_sup_suseconds_t" = no+    then+        if test "$WINDOWS" = "YES"+                          then+                              fptools_cv_htype_suseconds_t=Int32+                              fptools_cv_htype_sup_suseconds_t=yes+                          else+                              as_fn_error $? "type not found" "$LINENO" 5+                          fi+    fi++            if test "$fptools_cv_htype_sup_suseconds_t" = yes; then+        { $as_echo "$as_me:${as_lineno-$LINENO}: result: $fptools_cv_htype_suseconds_t" >&5+$as_echo "$fptools_cv_htype_suseconds_t" >&6; }++cat >>confdefs.h <<_ACEOF+#define HTYPE_SUSECONDS_T $fptools_cv_htype_suseconds_t+_ACEOF++    fi++++++++++    { $as_echo "$as_me:${as_lineno-$LINENO}: checking Haskell type for dev_t" >&5+$as_echo_n "checking Haskell type for dev_t... " >&6; }+    if test "${fptools_cv_htype_dev_t+set}" = set; then :+  $as_echo_n "(cached) " >&6+else++        fptools_cv_htype_sup_dev_t=yes+        if ac_fn_c_compute_int "$LINENO" "((dev_t)((int)((dev_t)1.4))) == ((dev_t)1.4)" "HTYPE_IS_INTEGRAL"        "+#include <stdio.h>+#include <stddef.h>++#if HAVE_SYS_TYPES_H+# include <sys/types.h>+#endif++#if HAVE_UNISTD_H+# include <unistd.h>+#endif++#if HAVE_SYS_STAT_H+# include <sys/stat.h>+#endif++#if HAVE_FCNTL_H+# include <fcntl.h>+#endif++#if HAVE_SIGNAL_H+# include <signal.h>+#endif++#if HAVE_TIME_H+# include <time.h>+#endif++#if HAVE_TERMIOS_H+# include <termios.h>+#endif++#if HAVE_STRING_H+# include <string.h>+#endif++#if HAVE_CTYPE_H+# include <ctype.h>+#endif++#if HAVE_INTTYPES_H+# include <inttypes.h>+#else+# if HAVE_STDINT_H+#  include <stdint.h>+# endif+#endif++#if HAVE_SYS_RESOURCE_H+# include <sys/resource.h>+#endif++#include <stdlib.h>+"; then :++else+  fptools_cv_htype_sup_dev_t=no+fi+++        if test "$fptools_cv_htype_sup_dev_t" = "yes"+        then+            if test "$HTYPE_IS_INTEGRAL" -eq 0+            then+                if ac_fn_c_compute_int "$LINENO" "sizeof(dev_t) == sizeof(float)" "HTYPE_IS_FLOAT"        "+#include <stdio.h>+#include <stddef.h>++#if HAVE_SYS_TYPES_H+# include <sys/types.h>+#endif++#if HAVE_UNISTD_H+# include <unistd.h>+#endif++#if HAVE_SYS_STAT_H+# include <sys/stat.h>+#endif++#if HAVE_FCNTL_H+# include <fcntl.h>+#endif++#if HAVE_SIGNAL_H+# include <signal.h>+#endif++#if HAVE_TIME_H+# include <time.h>+#endif++#if HAVE_TERMIOS_H+# include <termios.h>+#endif++#if HAVE_STRING_H+# include <string.h>+#endif++#if HAVE_CTYPE_H+# include <ctype.h>+#endif++#if HAVE_INTTYPES_H+# include <inttypes.h>+#else+# if HAVE_STDINT_H+#  include <stdint.h>+# endif+#endif++#if HAVE_SYS_RESOURCE_H+# include <sys/resource.h>+#endif++#include <stdlib.h>+"; then :++else+  fptools_cv_htype_sup_dev_t=no+fi+++                if ac_fn_c_compute_int "$LINENO" "sizeof(dev_t) == sizeof(double)" "HTYPE_IS_DOUBLE"        "+#include <stdio.h>+#include <stddef.h>++#if HAVE_SYS_TYPES_H+# include <sys/types.h>+#endif++#if HAVE_UNISTD_H+# include <unistd.h>+#endif++#if HAVE_SYS_STAT_H+# include <sys/stat.h>+#endif++#if HAVE_FCNTL_H+# include <fcntl.h>+#endif++#if HAVE_SIGNAL_H+# include <signal.h>+#endif++#if HAVE_TIME_H+# include <time.h>+#endif++#if HAVE_TERMIOS_H+# include <termios.h>+#endif++#if HAVE_STRING_H+# include <string.h>+#endif++#if HAVE_CTYPE_H+# include <ctype.h>+#endif++#if HAVE_INTTYPES_H+# include <inttypes.h>+#else+# if HAVE_STDINT_H+#  include <stdint.h>+# endif+#endif++#if HAVE_SYS_RESOURCE_H+# include <sys/resource.h>+#endif++#include <stdlib.h>+"; then :++else+  fptools_cv_htype_sup_dev_t=no+fi+++                if ac_fn_c_compute_int "$LINENO" "sizeof(dev_t) == sizeof(long double)" "HTYPE_IS_LDOUBLE"        "+#include <stdio.h>+#include <stddef.h>++#if HAVE_SYS_TYPES_H+# include <sys/types.h>+#endif++#if HAVE_UNISTD_H+# include <unistd.h>+#endif++#if HAVE_SYS_STAT_H+# include <sys/stat.h>+#endif++#if HAVE_FCNTL_H+# include <fcntl.h>+#endif++#if HAVE_SIGNAL_H+# include <signal.h>+#endif++#if HAVE_TIME_H+# include <time.h>+#endif++#if HAVE_TERMIOS_H+# include <termios.h>+#endif++#if HAVE_STRING_H+# include <string.h>+#endif++#if HAVE_CTYPE_H+# include <ctype.h>+#endif++#if HAVE_INTTYPES_H+# include <inttypes.h>+#else+# if HAVE_STDINT_H+#  include <stdint.h>+# endif+#endif++#if HAVE_SYS_RESOURCE_H+# include <sys/resource.h>+#endif++#include <stdlib.h>+"; then :++else+  fptools_cv_htype_sup_dev_t=no+fi+++                if test "$HTYPE_IS_FLOAT" -eq 1+                then+                    fptools_cv_htype_dev_t=Float+                elif test "$HTYPE_IS_DOUBLE" -eq 1+                then+                    fptools_cv_htype_dev_t=Double+                elif test "$HTYPE_IS_LDOUBLE" -eq 1+                then+                    fptools_cv_htype_dev_t=LDouble+                else+                    fptools_cv_htype_sup_dev_t=no+                fi+            else+                if ac_fn_c_compute_int "$LINENO" "((dev_t)(-1)) < ((dev_t)0)" "HTYPE_IS_SIGNED"        "+#include <stdio.h>+#include <stddef.h>++#if HAVE_SYS_TYPES_H+# include <sys/types.h>+#endif++#if HAVE_UNISTD_H+# include <unistd.h>+#endif++#if HAVE_SYS_STAT_H+# include <sys/stat.h>+#endif++#if HAVE_FCNTL_H+# include <fcntl.h>+#endif++#if HAVE_SIGNAL_H+# include <signal.h>+#endif++#if HAVE_TIME_H+# include <time.h>+#endif++#if HAVE_TERMIOS_H+# include <termios.h>+#endif++#if HAVE_STRING_H+# include <string.h>+#endif++#if HAVE_CTYPE_H+# include <ctype.h>+#endif++#if HAVE_INTTYPES_H+# include <inttypes.h>+#else+# if HAVE_STDINT_H+#  include <stdint.h>+# endif+#endif++#if HAVE_SYS_RESOURCE_H+# include <sys/resource.h>+#endif++#include <stdlib.h>+"; then :++else+  fptools_cv_htype_sup_dev_t=no+fi+++                if ac_fn_c_compute_int "$LINENO" "sizeof(dev_t) * 8" "HTYPE_SIZE"        "+#include <stdio.h>+#include <stddef.h>++#if HAVE_SYS_TYPES_H+# include <sys/types.h>+#endif++#if HAVE_UNISTD_H+# include <unistd.h>+#endif++#if HAVE_SYS_STAT_H+# include <sys/stat.h>+#endif++#if HAVE_FCNTL_H+# include <fcntl.h>+#endif++#if HAVE_SIGNAL_H+# include <signal.h>+#endif++#if HAVE_TIME_H+# include <time.h>+#endif++#if HAVE_TERMIOS_H+# include <termios.h>+#endif++#if HAVE_STRING_H+# include <string.h>+#endif++#if HAVE_CTYPE_H+# include <ctype.h>+#endif++#if HAVE_INTTYPES_H+# include <inttypes.h>+#else+# if HAVE_STDINT_H+#  include <stdint.h>+# endif+#endif++#if HAVE_SYS_RESOURCE_H+# include <sys/resource.h>+#endif++#include <stdlib.h>+"; then :++else+  fptools_cv_htype_sup_dev_t=no+fi+++                if test "$HTYPE_IS_SIGNED" -eq 0+                then+                    fptools_cv_htype_dev_t="Word$HTYPE_SIZE"+                else+                    fptools_cv_htype_dev_t="Int$HTYPE_SIZE"+                fi+            fi+        fi++fi++    if test "$fptools_cv_htype_sup_dev_t" = no+    then++        fptools_cv_htype_dev_t=NotReallyAType+        { $as_echo "$as_me:${as_lineno-$LINENO}: result: not supported" >&5+$as_echo "not supported" >&6; }++    fi++            if test "$fptools_cv_htype_sup_dev_t" = yes; then+        { $as_echo "$as_me:${as_lineno-$LINENO}: result: $fptools_cv_htype_dev_t" >&5+$as_echo "$fptools_cv_htype_dev_t" >&6; }++cat >>confdefs.h <<_ACEOF+#define HTYPE_DEV_T $fptools_cv_htype_dev_t+_ACEOF++    fi+++++++++++    { $as_echo "$as_me:${as_lineno-$LINENO}: checking Haskell type for ino_t" >&5+$as_echo_n "checking Haskell type for ino_t... " >&6; }+    if test "${fptools_cv_htype_ino_t+set}" = set; then :+  $as_echo_n "(cached) " >&6+else++        fptools_cv_htype_sup_ino_t=yes+        if ac_fn_c_compute_int "$LINENO" "((ino_t)((int)((ino_t)1.4))) == ((ino_t)1.4)" "HTYPE_IS_INTEGRAL"        "+#include <stdio.h>+#include <stddef.h>++#if HAVE_SYS_TYPES_H+# include <sys/types.h>+#endif++#if HAVE_UNISTD_H+# include <unistd.h>+#endif++#if HAVE_SYS_STAT_H+# include <sys/stat.h>+#endif++#if HAVE_FCNTL_H+# include <fcntl.h>+#endif++#if HAVE_SIGNAL_H+# include <signal.h>+#endif++#if HAVE_TIME_H+# include <time.h>+#endif++#if HAVE_TERMIOS_H+# include <termios.h>+#endif++#if HAVE_STRING_H+# include <string.h>+#endif++#if HAVE_CTYPE_H+# include <ctype.h>+#endif++#if HAVE_INTTYPES_H+# include <inttypes.h>+#else+# if HAVE_STDINT_H+#  include <stdint.h>+# endif+#endif++#if HAVE_SYS_RESOURCE_H+# include <sys/resource.h>+#endif++#include <stdlib.h>+"; then :++else+  fptools_cv_htype_sup_ino_t=no+fi+++        if test "$fptools_cv_htype_sup_ino_t" = "yes"+        then+            if test "$HTYPE_IS_INTEGRAL" -eq 0+            then+                if ac_fn_c_compute_int "$LINENO" "sizeof(ino_t) == sizeof(float)" "HTYPE_IS_FLOAT"        "+#include <stdio.h>+#include <stddef.h>++#if HAVE_SYS_TYPES_H+# include <sys/types.h>+#endif++#if HAVE_UNISTD_H+# include <unistd.h>+#endif++#if HAVE_SYS_STAT_H+# include <sys/stat.h>+#endif++#if HAVE_FCNTL_H+# include <fcntl.h>+#endif++#if HAVE_SIGNAL_H+# include <signal.h>+#endif++#if HAVE_TIME_H+# include <time.h>+#endif++#if HAVE_TERMIOS_H+# include <termios.h>+#endif++#if HAVE_STRING_H+# include <string.h>+#endif++#if HAVE_CTYPE_H+# include <ctype.h>+#endif++#if HAVE_INTTYPES_H+# include <inttypes.h>+#else+# if HAVE_STDINT_H+#  include <stdint.h>+# endif+#endif++#if HAVE_SYS_RESOURCE_H+# include <sys/resource.h>+#endif++#include <stdlib.h>+"; then :++else+  fptools_cv_htype_sup_ino_t=no+fi+++                if ac_fn_c_compute_int "$LINENO" "sizeof(ino_t) == sizeof(double)" "HTYPE_IS_DOUBLE"        "+#include <stdio.h>+#include <stddef.h>++#if HAVE_SYS_TYPES_H+# include <sys/types.h>+#endif++#if HAVE_UNISTD_H+# include <unistd.h>+#endif++#if HAVE_SYS_STAT_H+# include <sys/stat.h>+#endif++#if HAVE_FCNTL_H+# include <fcntl.h>+#endif++#if HAVE_SIGNAL_H+# include <signal.h>+#endif++#if HAVE_TIME_H+# include <time.h>+#endif++#if HAVE_TERMIOS_H+# include <termios.h>+#endif++#if HAVE_STRING_H+# include <string.h>+#endif++#if HAVE_CTYPE_H+# include <ctype.h>+#endif++#if HAVE_INTTYPES_H+# include <inttypes.h>+#else+# if HAVE_STDINT_H+#  include <stdint.h>+# endif+#endif++#if HAVE_SYS_RESOURCE_H+# include <sys/resource.h>+#endif++#include <stdlib.h>+"; then :++else+  fptools_cv_htype_sup_ino_t=no+fi+++                if ac_fn_c_compute_int "$LINENO" "sizeof(ino_t) == sizeof(long double)" "HTYPE_IS_LDOUBLE"        "+#include <stdio.h>+#include <stddef.h>++#if HAVE_SYS_TYPES_H+# include <sys/types.h>+#endif++#if HAVE_UNISTD_H+# include <unistd.h>+#endif++#if HAVE_SYS_STAT_H+# include <sys/stat.h>+#endif++#if HAVE_FCNTL_H+# include <fcntl.h>+#endif++#if HAVE_SIGNAL_H+# include <signal.h>+#endif++#if HAVE_TIME_H+# include <time.h>+#endif++#if HAVE_TERMIOS_H+# include <termios.h>+#endif++#if HAVE_STRING_H+# include <string.h>+#endif++#if HAVE_CTYPE_H+# include <ctype.h>+#endif++#if HAVE_INTTYPES_H+# include <inttypes.h>+#else+# if HAVE_STDINT_H+#  include <stdint.h>+# endif+#endif++#if HAVE_SYS_RESOURCE_H+# include <sys/resource.h>+#endif++#include <stdlib.h>+"; then :++else+  fptools_cv_htype_sup_ino_t=no+fi+++                if test "$HTYPE_IS_FLOAT" -eq 1+                then+                    fptools_cv_htype_ino_t=Float+                elif test "$HTYPE_IS_DOUBLE" -eq 1+                then+                    fptools_cv_htype_ino_t=Double+                elif test "$HTYPE_IS_LDOUBLE" -eq 1+                then+                    fptools_cv_htype_ino_t=LDouble+                else+                    fptools_cv_htype_sup_ino_t=no+                fi+            else+                if ac_fn_c_compute_int "$LINENO" "((ino_t)(-1)) < ((ino_t)0)" "HTYPE_IS_SIGNED"        "+#include <stdio.h>+#include <stddef.h>++#if HAVE_SYS_TYPES_H+# include <sys/types.h>+#endif++#if HAVE_UNISTD_H+# include <unistd.h>+#endif++#if HAVE_SYS_STAT_H+# include <sys/stat.h>+#endif++#if HAVE_FCNTL_H+# include <fcntl.h>+#endif++#if HAVE_SIGNAL_H+# include <signal.h>+#endif++#if HAVE_TIME_H+# include <time.h>+#endif++#if HAVE_TERMIOS_H+# include <termios.h>+#endif++#if HAVE_STRING_H+# include <string.h>+#endif++#if HAVE_CTYPE_H+# include <ctype.h>+#endif++#if HAVE_INTTYPES_H+# include <inttypes.h>+#else+# if HAVE_STDINT_H+#  include <stdint.h>+# endif+#endif++#if HAVE_SYS_RESOURCE_H+# include <sys/resource.h>+#endif++#include <stdlib.h>+"; then :++else+  fptools_cv_htype_sup_ino_t=no+fi+++                if ac_fn_c_compute_int "$LINENO" "sizeof(ino_t) * 8" "HTYPE_SIZE"        "+#include <stdio.h>+#include <stddef.h>++#if HAVE_SYS_TYPES_H+# include <sys/types.h>+#endif++#if HAVE_UNISTD_H+# include <unistd.h>+#endif++#if HAVE_SYS_STAT_H+# include <sys/stat.h>+#endif++#if HAVE_FCNTL_H+# include <fcntl.h>+#endif++#if HAVE_SIGNAL_H+# include <signal.h>+#endif++#if HAVE_TIME_H+# include <time.h>+#endif++#if HAVE_TERMIOS_H+# include <termios.h>+#endif++#if HAVE_STRING_H+# include <string.h>+#endif++#if HAVE_CTYPE_H+# include <ctype.h>+#endif++#if HAVE_INTTYPES_H+# include <inttypes.h>+#else+# if HAVE_STDINT_H+#  include <stdint.h>+# endif+#endif++#if HAVE_SYS_RESOURCE_H+# include <sys/resource.h>+#endif++#include <stdlib.h>+"; then :++else+  fptools_cv_htype_sup_ino_t=no+fi+++                if test "$HTYPE_IS_SIGNED" -eq 0+                then+                    fptools_cv_htype_ino_t="Word$HTYPE_SIZE"+                else+                    fptools_cv_htype_ino_t="Int$HTYPE_SIZE"+                fi+            fi+        fi++fi++    if test "$fptools_cv_htype_sup_ino_t" = no+    then++        fptools_cv_htype_ino_t=NotReallyAType+        { $as_echo "$as_me:${as_lineno-$LINENO}: result: not supported" >&5+$as_echo "not supported" >&6; }++    fi++            if test "$fptools_cv_htype_sup_ino_t" = yes; then+        { $as_echo "$as_me:${as_lineno-$LINENO}: result: $fptools_cv_htype_ino_t" >&5+$as_echo "$fptools_cv_htype_ino_t" >&6; }++cat >>confdefs.h <<_ACEOF+#define HTYPE_INO_T $fptools_cv_htype_ino_t+_ACEOF++    fi+++++++++++    { $as_echo "$as_me:${as_lineno-$LINENO}: checking Haskell type for mode_t" >&5+$as_echo_n "checking Haskell type for mode_t... " >&6; }+    if test "${fptools_cv_htype_mode_t+set}" = set; then :+  $as_echo_n "(cached) " >&6+else++        fptools_cv_htype_sup_mode_t=yes+        if ac_fn_c_compute_int "$LINENO" "((mode_t)((int)((mode_t)1.4))) == ((mode_t)1.4)" "HTYPE_IS_INTEGRAL"        "+#include <stdio.h>+#include <stddef.h>++#if HAVE_SYS_TYPES_H+# include <sys/types.h>+#endif++#if HAVE_UNISTD_H+# include <unistd.h>+#endif++#if HAVE_SYS_STAT_H+# include <sys/stat.h>+#endif++#if HAVE_FCNTL_H+# include <fcntl.h>+#endif++#if HAVE_SIGNAL_H+# include <signal.h>+#endif++#if HAVE_TIME_H+# include <time.h>+#endif++#if HAVE_TERMIOS_H+# include <termios.h>+#endif++#if HAVE_STRING_H+# include <string.h>+#endif++#if HAVE_CTYPE_H+# include <ctype.h>+#endif++#if HAVE_INTTYPES_H+# include <inttypes.h>+#else+# if HAVE_STDINT_H+#  include <stdint.h>+# endif+#endif++#if HAVE_SYS_RESOURCE_H+# include <sys/resource.h>+#endif++#include <stdlib.h>+"; then :++else+  fptools_cv_htype_sup_mode_t=no+fi+++        if test "$fptools_cv_htype_sup_mode_t" = "yes"+        then+            if test "$HTYPE_IS_INTEGRAL" -eq 0+            then+                if ac_fn_c_compute_int "$LINENO" "sizeof(mode_t) == sizeof(float)" "HTYPE_IS_FLOAT"        "+#include <stdio.h>+#include <stddef.h>++#if HAVE_SYS_TYPES_H+# include <sys/types.h>+#endif++#if HAVE_UNISTD_H+# include <unistd.h>+#endif++#if HAVE_SYS_STAT_H+# include <sys/stat.h>+#endif++#if HAVE_FCNTL_H+# include <fcntl.h>+#endif++#if HAVE_SIGNAL_H+# include <signal.h>+#endif++#if HAVE_TIME_H+# include <time.h>+#endif++#if HAVE_TERMIOS_H+# include <termios.h>+#endif++#if HAVE_STRING_H+# include <string.h>+#endif++#if HAVE_CTYPE_H+# include <ctype.h>+#endif++#if HAVE_INTTYPES_H+# include <inttypes.h>+#else+# if HAVE_STDINT_H+#  include <stdint.h>+# endif+#endif++#if HAVE_SYS_RESOURCE_H+# include <sys/resource.h>+#endif++#include <stdlib.h>+"; then :++else+  fptools_cv_htype_sup_mode_t=no+fi+++                if ac_fn_c_compute_int "$LINENO" "sizeof(mode_t) == sizeof(double)" "HTYPE_IS_DOUBLE"        "+#include <stdio.h>+#include <stddef.h>++#if HAVE_SYS_TYPES_H+# include <sys/types.h>+#endif++#if HAVE_UNISTD_H+# include <unistd.h>+#endif++#if HAVE_SYS_STAT_H+# include <sys/stat.h>+#endif++#if HAVE_FCNTL_H+# include <fcntl.h>+#endif++#if HAVE_SIGNAL_H+# include <signal.h>+#endif++#if HAVE_TIME_H+# include <time.h>+#endif++#if HAVE_TERMIOS_H+# include <termios.h>+#endif++#if HAVE_STRING_H+# include <string.h>+#endif++#if HAVE_CTYPE_H+# include <ctype.h>+#endif++#if HAVE_INTTYPES_H+# include <inttypes.h>+#else+# if HAVE_STDINT_H+#  include <stdint.h>+# endif+#endif++#if HAVE_SYS_RESOURCE_H+# include <sys/resource.h>+#endif++#include <stdlib.h>+"; then :++else+  fptools_cv_htype_sup_mode_t=no+fi+++                if ac_fn_c_compute_int "$LINENO" "sizeof(mode_t) == sizeof(long double)" "HTYPE_IS_LDOUBLE"        "+#include <stdio.h>+#include <stddef.h>++#if HAVE_SYS_TYPES_H+# include <sys/types.h>+#endif++#if HAVE_UNISTD_H+# include <unistd.h>+#endif++#if HAVE_SYS_STAT_H+# include <sys/stat.h>+#endif++#if HAVE_FCNTL_H+# include <fcntl.h>+#endif++#if HAVE_SIGNAL_H+# include <signal.h>+#endif++#if HAVE_TIME_H+# include <time.h>+#endif++#if HAVE_TERMIOS_H+# include <termios.h>+#endif++#if HAVE_STRING_H+# include <string.h>+#endif++#if HAVE_CTYPE_H+# include <ctype.h>+#endif++#if HAVE_INTTYPES_H+# include <inttypes.h>+#else+# if HAVE_STDINT_H+#  include <stdint.h>+# endif+#endif++#if HAVE_SYS_RESOURCE_H+# include <sys/resource.h>+#endif++#include <stdlib.h>+"; then :++else+  fptools_cv_htype_sup_mode_t=no+fi+++                if test "$HTYPE_IS_FLOAT" -eq 1+                then+                    fptools_cv_htype_mode_t=Float+                elif test "$HTYPE_IS_DOUBLE" -eq 1+                then+                    fptools_cv_htype_mode_t=Double+                elif test "$HTYPE_IS_LDOUBLE" -eq 1+                then+                    fptools_cv_htype_mode_t=LDouble+                else+                    fptools_cv_htype_sup_mode_t=no+                fi+            else+                if ac_fn_c_compute_int "$LINENO" "((mode_t)(-1)) < ((mode_t)0)" "HTYPE_IS_SIGNED"        "+#include <stdio.h>+#include <stddef.h>++#if HAVE_SYS_TYPES_H+# include <sys/types.h>+#endif++#if HAVE_UNISTD_H+# include <unistd.h>+#endif++#if HAVE_SYS_STAT_H+# include <sys/stat.h>+#endif++#if HAVE_FCNTL_H+# include <fcntl.h>+#endif++#if HAVE_SIGNAL_H+# include <signal.h>+#endif++#if HAVE_TIME_H+# include <time.h>+#endif++#if HAVE_TERMIOS_H+# include <termios.h>+#endif++#if HAVE_STRING_H+# include <string.h>+#endif++#if HAVE_CTYPE_H+# include <ctype.h>+#endif++#if HAVE_INTTYPES_H+# include <inttypes.h>+#else+# if HAVE_STDINT_H+#  include <stdint.h>+# endif+#endif++#if HAVE_SYS_RESOURCE_H+# include <sys/resource.h>+#endif++#include <stdlib.h>+"; then :++else+  fptools_cv_htype_sup_mode_t=no+fi+++                if ac_fn_c_compute_int "$LINENO" "sizeof(mode_t) * 8" "HTYPE_SIZE"        "+#include <stdio.h>+#include <stddef.h>++#if HAVE_SYS_TYPES_H+# include <sys/types.h>+#endif++#if HAVE_UNISTD_H+# include <unistd.h>+#endif++#if HAVE_SYS_STAT_H+# include <sys/stat.h>+#endif++#if HAVE_FCNTL_H+# include <fcntl.h>+#endif++#if HAVE_SIGNAL_H+# include <signal.h>+#endif++#if HAVE_TIME_H+# include <time.h>+#endif++#if HAVE_TERMIOS_H+# include <termios.h>+#endif++#if HAVE_STRING_H+# include <string.h>+#endif++#if HAVE_CTYPE_H+# include <ctype.h>+#endif++#if HAVE_INTTYPES_H+# include <inttypes.h>+#else+# if HAVE_STDINT_H+#  include <stdint.h>+# endif+#endif++#if HAVE_SYS_RESOURCE_H+# include <sys/resource.h>+#endif++#include <stdlib.h>+"; then :++else+  fptools_cv_htype_sup_mode_t=no+fi+++                if test "$HTYPE_IS_SIGNED" -eq 0+                then+                    fptools_cv_htype_mode_t="Word$HTYPE_SIZE"+                else+                    fptools_cv_htype_mode_t="Int$HTYPE_SIZE"+                fi+            fi+        fi++fi++    if test "$fptools_cv_htype_sup_mode_t" = no+    then++        fptools_cv_htype_mode_t=NotReallyAType+        { $as_echo "$as_me:${as_lineno-$LINENO}: result: not supported" >&5+$as_echo "not supported" >&6; }++    fi++            if test "$fptools_cv_htype_sup_mode_t" = yes; then+        { $as_echo "$as_me:${as_lineno-$LINENO}: result: $fptools_cv_htype_mode_t" >&5+$as_echo "$fptools_cv_htype_mode_t" >&6; }++cat >>confdefs.h <<_ACEOF+#define HTYPE_MODE_T $fptools_cv_htype_mode_t+_ACEOF++    fi+++++++++++    { $as_echo "$as_me:${as_lineno-$LINENO}: checking Haskell type for off_t" >&5+$as_echo_n "checking Haskell type for off_t... " >&6; }+    if test "${fptools_cv_htype_off_t+set}" = set; then :+  $as_echo_n "(cached) " >&6+else++        fptools_cv_htype_sup_off_t=yes+        if ac_fn_c_compute_int "$LINENO" "((off_t)((int)((off_t)1.4))) == ((off_t)1.4)" "HTYPE_IS_INTEGRAL"        "+#include <stdio.h>+#include <stddef.h>++#if HAVE_SYS_TYPES_H+# include <sys/types.h>+#endif++#if HAVE_UNISTD_H+# include <unistd.h>+#endif++#if HAVE_SYS_STAT_H+# include <sys/stat.h>+#endif++#if HAVE_FCNTL_H+# include <fcntl.h>+#endif++#if HAVE_SIGNAL_H+# include <signal.h>+#endif++#if HAVE_TIME_H+# include <time.h>+#endif++#if HAVE_TERMIOS_H+# include <termios.h>+#endif++#if HAVE_STRING_H+# include <string.h>+#endif++#if HAVE_CTYPE_H+# include <ctype.h>+#endif++#if HAVE_INTTYPES_H+# include <inttypes.h>+#else+# if HAVE_STDINT_H+#  include <stdint.h>+# endif+#endif++#if HAVE_SYS_RESOURCE_H+# include <sys/resource.h>+#endif++#include <stdlib.h>+"; then :++else+  fptools_cv_htype_sup_off_t=no+fi+++        if test "$fptools_cv_htype_sup_off_t" = "yes"+        then+            if test "$HTYPE_IS_INTEGRAL" -eq 0+            then+                if ac_fn_c_compute_int "$LINENO" "sizeof(off_t) == sizeof(float)" "HTYPE_IS_FLOAT"        "+#include <stdio.h>+#include <stddef.h>++#if HAVE_SYS_TYPES_H+# include <sys/types.h>+#endif++#if HAVE_UNISTD_H+# include <unistd.h>+#endif++#if HAVE_SYS_STAT_H+# include <sys/stat.h>+#endif++#if HAVE_FCNTL_H+# include <fcntl.h>+#endif++#if HAVE_SIGNAL_H+# include <signal.h>+#endif++#if HAVE_TIME_H+# include <time.h>+#endif++#if HAVE_TERMIOS_H+# include <termios.h>+#endif++#if HAVE_STRING_H+# include <string.h>+#endif++#if HAVE_CTYPE_H+# include <ctype.h>+#endif++#if HAVE_INTTYPES_H+# include <inttypes.h>+#else+# if HAVE_STDINT_H+#  include <stdint.h>+# endif+#endif++#if HAVE_SYS_RESOURCE_H+# include <sys/resource.h>+#endif++#include <stdlib.h>+"; then :++else+  fptools_cv_htype_sup_off_t=no+fi+++                if ac_fn_c_compute_int "$LINENO" "sizeof(off_t) == sizeof(double)" "HTYPE_IS_DOUBLE"        "+#include <stdio.h>+#include <stddef.h>++#if HAVE_SYS_TYPES_H+# include <sys/types.h>+#endif++#if HAVE_UNISTD_H+# include <unistd.h>+#endif++#if HAVE_SYS_STAT_H+# include <sys/stat.h>+#endif++#if HAVE_FCNTL_H+# include <fcntl.h>+#endif++#if HAVE_SIGNAL_H+# include <signal.h>+#endif++#if HAVE_TIME_H+# include <time.h>+#endif++#if HAVE_TERMIOS_H+# include <termios.h>+#endif++#if HAVE_STRING_H+# include <string.h>+#endif++#if HAVE_CTYPE_H+# include <ctype.h>+#endif++#if HAVE_INTTYPES_H+# include <inttypes.h>+#else+# if HAVE_STDINT_H+#  include <stdint.h>+# endif+#endif++#if HAVE_SYS_RESOURCE_H+# include <sys/resource.h>+#endif++#include <stdlib.h>+"; then :++else+  fptools_cv_htype_sup_off_t=no+fi+++                if ac_fn_c_compute_int "$LINENO" "sizeof(off_t) == sizeof(long double)" "HTYPE_IS_LDOUBLE"        "+#include <stdio.h>+#include <stddef.h>++#if HAVE_SYS_TYPES_H+# include <sys/types.h>+#endif++#if HAVE_UNISTD_H+# include <unistd.h>+#endif++#if HAVE_SYS_STAT_H+# include <sys/stat.h>+#endif++#if HAVE_FCNTL_H+# include <fcntl.h>+#endif++#if HAVE_SIGNAL_H+# include <signal.h>+#endif++#if HAVE_TIME_H+# include <time.h>+#endif++#if HAVE_TERMIOS_H+# include <termios.h>+#endif++#if HAVE_STRING_H+# include <string.h>+#endif++#if HAVE_CTYPE_H+# include <ctype.h>+#endif++#if HAVE_INTTYPES_H+# include <inttypes.h>+#else+# if HAVE_STDINT_H+#  include <stdint.h>+# endif+#endif++#if HAVE_SYS_RESOURCE_H+# include <sys/resource.h>+#endif++#include <stdlib.h>+"; then :++else+  fptools_cv_htype_sup_off_t=no+fi+++                if test "$HTYPE_IS_FLOAT" -eq 1+                then+                    fptools_cv_htype_off_t=Float+                elif test "$HTYPE_IS_DOUBLE" -eq 1+                then+                    fptools_cv_htype_off_t=Double+                elif test "$HTYPE_IS_LDOUBLE" -eq 1+                then+                    fptools_cv_htype_off_t=LDouble+                else+                    fptools_cv_htype_sup_off_t=no+                fi+            else+                if ac_fn_c_compute_int "$LINENO" "((off_t)(-1)) < ((off_t)0)" "HTYPE_IS_SIGNED"        "+#include <stdio.h>+#include <stddef.h>++#if HAVE_SYS_TYPES_H+# include <sys/types.h>+#endif++#if HAVE_UNISTD_H+# include <unistd.h>+#endif++#if HAVE_SYS_STAT_H+# include <sys/stat.h>+#endif++#if HAVE_FCNTL_H+# include <fcntl.h>+#endif++#if HAVE_SIGNAL_H+# include <signal.h>+#endif++#if HAVE_TIME_H+# include <time.h>+#endif++#if HAVE_TERMIOS_H+# include <termios.h>+#endif++#if HAVE_STRING_H+# include <string.h>+#endif++#if HAVE_CTYPE_H+# include <ctype.h>+#endif++#if HAVE_INTTYPES_H+# include <inttypes.h>+#else+# if HAVE_STDINT_H+#  include <stdint.h>+# endif+#endif++#if HAVE_SYS_RESOURCE_H+# include <sys/resource.h>+#endif++#include <stdlib.h>+"; then :++else+  fptools_cv_htype_sup_off_t=no+fi+++                if ac_fn_c_compute_int "$LINENO" "sizeof(off_t) * 8" "HTYPE_SIZE"        "+#include <stdio.h>+#include <stddef.h>++#if HAVE_SYS_TYPES_H+# include <sys/types.h>+#endif++#if HAVE_UNISTD_H+# include <unistd.h>+#endif++#if HAVE_SYS_STAT_H+# include <sys/stat.h>+#endif++#if HAVE_FCNTL_H+# include <fcntl.h>+#endif++#if HAVE_SIGNAL_H+# include <signal.h>+#endif++#if HAVE_TIME_H+# include <time.h>+#endif++#if HAVE_TERMIOS_H+# include <termios.h>+#endif++#if HAVE_STRING_H+# include <string.h>+#endif++#if HAVE_CTYPE_H+# include <ctype.h>+#endif++#if HAVE_INTTYPES_H+# include <inttypes.h>+#else+# if HAVE_STDINT_H+#  include <stdint.h>+# endif+#endif++#if HAVE_SYS_RESOURCE_H+# include <sys/resource.h>+#endif++#include <stdlib.h>+"; then :++else+  fptools_cv_htype_sup_off_t=no+fi+++                if test "$HTYPE_IS_SIGNED" -eq 0+                then+                    fptools_cv_htype_off_t="Word$HTYPE_SIZE"+                else+                    fptools_cv_htype_off_t="Int$HTYPE_SIZE"+                fi+            fi+        fi++fi++    if test "$fptools_cv_htype_sup_off_t" = no+    then++        fptools_cv_htype_off_t=NotReallyAType+        { $as_echo "$as_me:${as_lineno-$LINENO}: result: not supported" >&5+$as_echo "not supported" >&6; }++    fi++            if test "$fptools_cv_htype_sup_off_t" = yes; then+        { $as_echo "$as_me:${as_lineno-$LINENO}: result: $fptools_cv_htype_off_t" >&5+$as_echo "$fptools_cv_htype_off_t" >&6; }++cat >>confdefs.h <<_ACEOF+#define HTYPE_OFF_T $fptools_cv_htype_off_t+_ACEOF++    fi+++++++++++    { $as_echo "$as_me:${as_lineno-$LINENO}: checking Haskell type for pid_t" >&5+$as_echo_n "checking Haskell type for pid_t... " >&6; }+    if test "${fptools_cv_htype_pid_t+set}" = set; then :+  $as_echo_n "(cached) " >&6+else++        fptools_cv_htype_sup_pid_t=yes+        if ac_fn_c_compute_int "$LINENO" "((pid_t)((int)((pid_t)1.4))) == ((pid_t)1.4)" "HTYPE_IS_INTEGRAL"        "+#include <stdio.h>+#include <stddef.h>++#if HAVE_SYS_TYPES_H+# include <sys/types.h>+#endif++#if HAVE_UNISTD_H+# include <unistd.h>+#endif++#if HAVE_SYS_STAT_H+# include <sys/stat.h>+#endif++#if HAVE_FCNTL_H+# include <fcntl.h>+#endif++#if HAVE_SIGNAL_H+# include <signal.h>+#endif++#if HAVE_TIME_H+# include <time.h>+#endif++#if HAVE_TERMIOS_H+# include <termios.h>+#endif++#if HAVE_STRING_H+# include <string.h>+#endif++#if HAVE_CTYPE_H+# include <ctype.h>+#endif++#if HAVE_INTTYPES_H+# include <inttypes.h>+#else+# if HAVE_STDINT_H+#  include <stdint.h>+# endif+#endif++#if HAVE_SYS_RESOURCE_H+# include <sys/resource.h>+#endif++#include <stdlib.h>+"; then :++else+  fptools_cv_htype_sup_pid_t=no+fi+++        if test "$fptools_cv_htype_sup_pid_t" = "yes"+        then+            if test "$HTYPE_IS_INTEGRAL" -eq 0+            then+                if ac_fn_c_compute_int "$LINENO" "sizeof(pid_t) == sizeof(float)" "HTYPE_IS_FLOAT"        "+#include <stdio.h>+#include <stddef.h>++#if HAVE_SYS_TYPES_H+# include <sys/types.h>+#endif++#if HAVE_UNISTD_H+# include <unistd.h>+#endif++#if HAVE_SYS_STAT_H+# include <sys/stat.h>+#endif++#if HAVE_FCNTL_H+# include <fcntl.h>+#endif++#if HAVE_SIGNAL_H+# include <signal.h>+#endif++#if HAVE_TIME_H+# include <time.h>+#endif++#if HAVE_TERMIOS_H+# include <termios.h>+#endif++#if HAVE_STRING_H+# include <string.h>+#endif++#if HAVE_CTYPE_H+# include <ctype.h>+#endif++#if HAVE_INTTYPES_H+# include <inttypes.h>+#else+# if HAVE_STDINT_H+#  include <stdint.h>+# endif+#endif++#if HAVE_SYS_RESOURCE_H+# include <sys/resource.h>+#endif++#include <stdlib.h>+"; then :++else+  fptools_cv_htype_sup_pid_t=no+fi+++                if ac_fn_c_compute_int "$LINENO" "sizeof(pid_t) == sizeof(double)" "HTYPE_IS_DOUBLE"        "+#include <stdio.h>+#include <stddef.h>++#if HAVE_SYS_TYPES_H+# include <sys/types.h>+#endif++#if HAVE_UNISTD_H+# include <unistd.h>+#endif++#if HAVE_SYS_STAT_H+# include <sys/stat.h>+#endif++#if HAVE_FCNTL_H+# include <fcntl.h>+#endif++#if HAVE_SIGNAL_H+# include <signal.h>+#endif++#if HAVE_TIME_H+# include <time.h>+#endif++#if HAVE_TERMIOS_H+# include <termios.h>+#endif++#if HAVE_STRING_H+# include <string.h>+#endif++#if HAVE_CTYPE_H+# include <ctype.h>+#endif++#if HAVE_INTTYPES_H+# include <inttypes.h>+#else+# if HAVE_STDINT_H+#  include <stdint.h>+# endif+#endif++#if HAVE_SYS_RESOURCE_H+# include <sys/resource.h>+#endif++#include <stdlib.h>+"; then :++else+  fptools_cv_htype_sup_pid_t=no+fi+++                if ac_fn_c_compute_int "$LINENO" "sizeof(pid_t) == sizeof(long double)" "HTYPE_IS_LDOUBLE"        "+#include <stdio.h>+#include <stddef.h>++#if HAVE_SYS_TYPES_H+# include <sys/types.h>+#endif++#if HAVE_UNISTD_H+# include <unistd.h>+#endif++#if HAVE_SYS_STAT_H+# include <sys/stat.h>+#endif++#if HAVE_FCNTL_H+# include <fcntl.h>+#endif++#if HAVE_SIGNAL_H+# include <signal.h>+#endif++#if HAVE_TIME_H+# include <time.h>+#endif++#if HAVE_TERMIOS_H+# include <termios.h>+#endif++#if HAVE_STRING_H+# include <string.h>+#endif++#if HAVE_CTYPE_H+# include <ctype.h>+#endif++#if HAVE_INTTYPES_H+# include <inttypes.h>+#else+# if HAVE_STDINT_H+#  include <stdint.h>+# endif+#endif++#if HAVE_SYS_RESOURCE_H+# include <sys/resource.h>+#endif++#include <stdlib.h>+"; then :++else+  fptools_cv_htype_sup_pid_t=no+fi+++                if test "$HTYPE_IS_FLOAT" -eq 1+                then+                    fptools_cv_htype_pid_t=Float+                elif test "$HTYPE_IS_DOUBLE" -eq 1+                then+                    fptools_cv_htype_pid_t=Double+                elif test "$HTYPE_IS_LDOUBLE" -eq 1+                then+                    fptools_cv_htype_pid_t=LDouble+                else+                    fptools_cv_htype_sup_pid_t=no+                fi+            else+                if ac_fn_c_compute_int "$LINENO" "((pid_t)(-1)) < ((pid_t)0)" "HTYPE_IS_SIGNED"        "+#include <stdio.h>+#include <stddef.h>++#if HAVE_SYS_TYPES_H+# include <sys/types.h>+#endif++#if HAVE_UNISTD_H+# include <unistd.h>+#endif++#if HAVE_SYS_STAT_H+# include <sys/stat.h>+#endif++#if HAVE_FCNTL_H+# include <fcntl.h>+#endif++#if HAVE_SIGNAL_H+# include <signal.h>+#endif++#if HAVE_TIME_H+# include <time.h>+#endif++#if HAVE_TERMIOS_H+# include <termios.h>+#endif++#if HAVE_STRING_H+# include <string.h>+#endif++#if HAVE_CTYPE_H+# include <ctype.h>+#endif++#if HAVE_INTTYPES_H+# include <inttypes.h>+#else+# if HAVE_STDINT_H+#  include <stdint.h>+# endif+#endif++#if HAVE_SYS_RESOURCE_H+# include <sys/resource.h>+#endif++#include <stdlib.h>+"; then :++else+  fptools_cv_htype_sup_pid_t=no+fi+++                if ac_fn_c_compute_int "$LINENO" "sizeof(pid_t) * 8" "HTYPE_SIZE"        "+#include <stdio.h>+#include <stddef.h>++#if HAVE_SYS_TYPES_H+# include <sys/types.h>+#endif++#if HAVE_UNISTD_H+# include <unistd.h>+#endif++#if HAVE_SYS_STAT_H+# include <sys/stat.h>+#endif++#if HAVE_FCNTL_H+# include <fcntl.h>+#endif++#if HAVE_SIGNAL_H+# include <signal.h>+#endif++#if HAVE_TIME_H+# include <time.h>+#endif++#if HAVE_TERMIOS_H+# include <termios.h>+#endif++#if HAVE_STRING_H+# include <string.h>+#endif++#if HAVE_CTYPE_H+# include <ctype.h>+#endif++#if HAVE_INTTYPES_H+# include <inttypes.h>+#else+# if HAVE_STDINT_H+#  include <stdint.h>+# endif+#endif++#if HAVE_SYS_RESOURCE_H+# include <sys/resource.h>+#endif++#include <stdlib.h>+"; then :++else+  fptools_cv_htype_sup_pid_t=no+fi+++                if test "$HTYPE_IS_SIGNED" -eq 0+                then+                    fptools_cv_htype_pid_t="Word$HTYPE_SIZE"+                else+                    fptools_cv_htype_pid_t="Int$HTYPE_SIZE"+                fi+            fi+        fi++fi++    if test "$fptools_cv_htype_sup_pid_t" = no+    then++        fptools_cv_htype_pid_t=NotReallyAType+        { $as_echo "$as_me:${as_lineno-$LINENO}: result: not supported" >&5+$as_echo "not supported" >&6; }++    fi++            if test "$fptools_cv_htype_sup_pid_t" = yes; then+        { $as_echo "$as_me:${as_lineno-$LINENO}: result: $fptools_cv_htype_pid_t" >&5+$as_echo "$fptools_cv_htype_pid_t" >&6; }++cat >>confdefs.h <<_ACEOF+#define HTYPE_PID_T $fptools_cv_htype_pid_t+_ACEOF++    fi+++++++++++    { $as_echo "$as_me:${as_lineno-$LINENO}: checking Haskell type for gid_t" >&5+$as_echo_n "checking Haskell type for gid_t... " >&6; }+    if test "${fptools_cv_htype_gid_t+set}" = set; then :+  $as_echo_n "(cached) " >&6+else++        fptools_cv_htype_sup_gid_t=yes+        if ac_fn_c_compute_int "$LINENO" "((gid_t)((int)((gid_t)1.4))) == ((gid_t)1.4)" "HTYPE_IS_INTEGRAL"        "+#include <stdio.h>+#include <stddef.h>++#if HAVE_SYS_TYPES_H+# include <sys/types.h>+#endif++#if HAVE_UNISTD_H+# include <unistd.h>+#endif++#if HAVE_SYS_STAT_H+# include <sys/stat.h>+#endif++#if HAVE_FCNTL_H+# include <fcntl.h>+#endif++#if HAVE_SIGNAL_H+# include <signal.h>+#endif++#if HAVE_TIME_H+# include <time.h>+#endif++#if HAVE_TERMIOS_H+# include <termios.h>+#endif++#if HAVE_STRING_H+# include <string.h>+#endif++#if HAVE_CTYPE_H+# include <ctype.h>+#endif++#if HAVE_INTTYPES_H+# include <inttypes.h>+#else+# if HAVE_STDINT_H+#  include <stdint.h>+# endif+#endif++#if HAVE_SYS_RESOURCE_H+# include <sys/resource.h>+#endif++#include <stdlib.h>+"; then :++else+  fptools_cv_htype_sup_gid_t=no+fi+++        if test "$fptools_cv_htype_sup_gid_t" = "yes"+        then+            if test "$HTYPE_IS_INTEGRAL" -eq 0+            then+                if ac_fn_c_compute_int "$LINENO" "sizeof(gid_t) == sizeof(float)" "HTYPE_IS_FLOAT"        "+#include <stdio.h>+#include <stddef.h>++#if HAVE_SYS_TYPES_H+# include <sys/types.h>+#endif++#if HAVE_UNISTD_H+# include <unistd.h>+#endif++#if HAVE_SYS_STAT_H+# include <sys/stat.h>+#endif++#if HAVE_FCNTL_H+# include <fcntl.h>+#endif++#if HAVE_SIGNAL_H+# include <signal.h>+#endif++#if HAVE_TIME_H+# include <time.h>+#endif++#if HAVE_TERMIOS_H+# include <termios.h>+#endif++#if HAVE_STRING_H+# include <string.h>+#endif++#if HAVE_CTYPE_H+# include <ctype.h>+#endif++#if HAVE_INTTYPES_H+# include <inttypes.h>+#else+# if HAVE_STDINT_H+#  include <stdint.h>+# endif+#endif++#if HAVE_SYS_RESOURCE_H+# include <sys/resource.h>+#endif++#include <stdlib.h>+"; then :++else+  fptools_cv_htype_sup_gid_t=no+fi+++                if ac_fn_c_compute_int "$LINENO" "sizeof(gid_t) == sizeof(double)" "HTYPE_IS_DOUBLE"        "+#include <stdio.h>+#include <stddef.h>++#if HAVE_SYS_TYPES_H+# include <sys/types.h>+#endif++#if HAVE_UNISTD_H+# include <unistd.h>+#endif++#if HAVE_SYS_STAT_H+# include <sys/stat.h>+#endif++#if HAVE_FCNTL_H+# include <fcntl.h>+#endif++#if HAVE_SIGNAL_H+# include <signal.h>+#endif++#if HAVE_TIME_H+# include <time.h>+#endif++#if HAVE_TERMIOS_H+# include <termios.h>+#endif++#if HAVE_STRING_H+# include <string.h>+#endif++#if HAVE_CTYPE_H+# include <ctype.h>+#endif++#if HAVE_INTTYPES_H+# include <inttypes.h>+#else+# if HAVE_STDINT_H+#  include <stdint.h>+# endif+#endif++#if HAVE_SYS_RESOURCE_H+# include <sys/resource.h>+#endif++#include <stdlib.h>+"; then :++else+  fptools_cv_htype_sup_gid_t=no+fi+++                if ac_fn_c_compute_int "$LINENO" "sizeof(gid_t) == sizeof(long double)" "HTYPE_IS_LDOUBLE"        "+#include <stdio.h>+#include <stddef.h>++#if HAVE_SYS_TYPES_H+# include <sys/types.h>+#endif++#if HAVE_UNISTD_H+# include <unistd.h>+#endif++#if HAVE_SYS_STAT_H+# include <sys/stat.h>+#endif++#if HAVE_FCNTL_H+# include <fcntl.h>+#endif++#if HAVE_SIGNAL_H+# include <signal.h>+#endif++#if HAVE_TIME_H+# include <time.h>+#endif++#if HAVE_TERMIOS_H+# include <termios.h>+#endif++#if HAVE_STRING_H+# include <string.h>+#endif++#if HAVE_CTYPE_H+# include <ctype.h>+#endif++#if HAVE_INTTYPES_H+# include <inttypes.h>+#else+# if HAVE_STDINT_H+#  include <stdint.h>+# endif+#endif++#if HAVE_SYS_RESOURCE_H+# include <sys/resource.h>+#endif++#include <stdlib.h>+"; then :++else+  fptools_cv_htype_sup_gid_t=no+fi+++                if test "$HTYPE_IS_FLOAT" -eq 1+                then+                    fptools_cv_htype_gid_t=Float+                elif test "$HTYPE_IS_DOUBLE" -eq 1+                then+                    fptools_cv_htype_gid_t=Double+                elif test "$HTYPE_IS_LDOUBLE" -eq 1+                then+                    fptools_cv_htype_gid_t=LDouble+                else+                    fptools_cv_htype_sup_gid_t=no+                fi+            else+                if ac_fn_c_compute_int "$LINENO" "((gid_t)(-1)) < ((gid_t)0)" "HTYPE_IS_SIGNED"        "+#include <stdio.h>+#include <stddef.h>++#if HAVE_SYS_TYPES_H+# include <sys/types.h>+#endif++#if HAVE_UNISTD_H+# include <unistd.h>+#endif++#if HAVE_SYS_STAT_H+# include <sys/stat.h>+#endif++#if HAVE_FCNTL_H+# include <fcntl.h>+#endif++#if HAVE_SIGNAL_H+# include <signal.h>+#endif++#if HAVE_TIME_H+# include <time.h>+#endif++#if HAVE_TERMIOS_H+# include <termios.h>+#endif++#if HAVE_STRING_H+# include <string.h>+#endif++#if HAVE_CTYPE_H+# include <ctype.h>+#endif++#if HAVE_INTTYPES_H+# include <inttypes.h>+#else+# if HAVE_STDINT_H+#  include <stdint.h>+# endif+#endif++#if HAVE_SYS_RESOURCE_H+# include <sys/resource.h>+#endif++#include <stdlib.h>+"; then :++else+  fptools_cv_htype_sup_gid_t=no+fi+++                if ac_fn_c_compute_int "$LINENO" "sizeof(gid_t) * 8" "HTYPE_SIZE"        "+#include <stdio.h>+#include <stddef.h>++#if HAVE_SYS_TYPES_H+# include <sys/types.h>+#endif++#if HAVE_UNISTD_H+# include <unistd.h>+#endif++#if HAVE_SYS_STAT_H+# include <sys/stat.h>+#endif++#if HAVE_FCNTL_H+# include <fcntl.h>+#endif++#if HAVE_SIGNAL_H+# include <signal.h>+#endif++#if HAVE_TIME_H+# include <time.h>+#endif++#if HAVE_TERMIOS_H+# include <termios.h>+#endif++#if HAVE_STRING_H+# include <string.h>+#endif++#if HAVE_CTYPE_H+# include <ctype.h>+#endif++#if HAVE_INTTYPES_H+# include <inttypes.h>+#else+# if HAVE_STDINT_H+#  include <stdint.h>+# endif+#endif++#if HAVE_SYS_RESOURCE_H+# include <sys/resource.h>+#endif++#include <stdlib.h>+"; then :++else+  fptools_cv_htype_sup_gid_t=no+fi+++                if test "$HTYPE_IS_SIGNED" -eq 0+                then+                    fptools_cv_htype_gid_t="Word$HTYPE_SIZE"+                else+                    fptools_cv_htype_gid_t="Int$HTYPE_SIZE"+                fi+            fi+        fi++fi++    if test "$fptools_cv_htype_sup_gid_t" = no+    then++        fptools_cv_htype_gid_t=NotReallyAType+        { $as_echo "$as_me:${as_lineno-$LINENO}: result: not supported" >&5+$as_echo "not supported" >&6; }++    fi++            if test "$fptools_cv_htype_sup_gid_t" = yes; then+        { $as_echo "$as_me:${as_lineno-$LINENO}: result: $fptools_cv_htype_gid_t" >&5+$as_echo "$fptools_cv_htype_gid_t" >&6; }++cat >>confdefs.h <<_ACEOF+#define HTYPE_GID_T $fptools_cv_htype_gid_t+_ACEOF++    fi+++++++++++    { $as_echo "$as_me:${as_lineno-$LINENO}: checking Haskell type for uid_t" >&5+$as_echo_n "checking Haskell type for uid_t... " >&6; }+    if test "${fptools_cv_htype_uid_t+set}" = set; then :+  $as_echo_n "(cached) " >&6+else++        fptools_cv_htype_sup_uid_t=yes+        if ac_fn_c_compute_int "$LINENO" "((uid_t)((int)((uid_t)1.4))) == ((uid_t)1.4)" "HTYPE_IS_INTEGRAL"        "+#include <stdio.h>+#include <stddef.h>++#if HAVE_SYS_TYPES_H+# include <sys/types.h>+#endif++#if HAVE_UNISTD_H+# include <unistd.h>+#endif++#if HAVE_SYS_STAT_H+# include <sys/stat.h>+#endif++#if HAVE_FCNTL_H+# include <fcntl.h>+#endif++#if HAVE_SIGNAL_H+# include <signal.h>+#endif++#if HAVE_TIME_H+# include <time.h>+#endif++#if HAVE_TERMIOS_H+# include <termios.h>+#endif++#if HAVE_STRING_H+# include <string.h>+#endif++#if HAVE_CTYPE_H+# include <ctype.h>+#endif++#if HAVE_INTTYPES_H+# include <inttypes.h>+#else+# if HAVE_STDINT_H+#  include <stdint.h>+# endif+#endif++#if HAVE_SYS_RESOURCE_H+# include <sys/resource.h>+#endif++#include <stdlib.h>+"; then :++else+  fptools_cv_htype_sup_uid_t=no+fi+++        if test "$fptools_cv_htype_sup_uid_t" = "yes"+        then+            if test "$HTYPE_IS_INTEGRAL" -eq 0+            then+                if ac_fn_c_compute_int "$LINENO" "sizeof(uid_t) == sizeof(float)" "HTYPE_IS_FLOAT"        "+#include <stdio.h>+#include <stddef.h>++#if HAVE_SYS_TYPES_H+# include <sys/types.h>+#endif++#if HAVE_UNISTD_H+# include <unistd.h>+#endif++#if HAVE_SYS_STAT_H+# include <sys/stat.h>+#endif++#if HAVE_FCNTL_H+# include <fcntl.h>+#endif++#if HAVE_SIGNAL_H+# include <signal.h>+#endif++#if HAVE_TIME_H+# include <time.h>+#endif++#if HAVE_TERMIOS_H+# include <termios.h>+#endif++#if HAVE_STRING_H+# include <string.h>+#endif++#if HAVE_CTYPE_H+# include <ctype.h>+#endif++#if HAVE_INTTYPES_H+# include <inttypes.h>+#else+# if HAVE_STDINT_H+#  include <stdint.h>+# endif+#endif++#if HAVE_SYS_RESOURCE_H+# include <sys/resource.h>+#endif++#include <stdlib.h>+"; then :++else+  fptools_cv_htype_sup_uid_t=no+fi+++                if ac_fn_c_compute_int "$LINENO" "sizeof(uid_t) == sizeof(double)" "HTYPE_IS_DOUBLE"        "+#include <stdio.h>+#include <stddef.h>++#if HAVE_SYS_TYPES_H+# include <sys/types.h>+#endif++#if HAVE_UNISTD_H+# include <unistd.h>+#endif++#if HAVE_SYS_STAT_H+# include <sys/stat.h>+#endif++#if HAVE_FCNTL_H+# include <fcntl.h>+#endif++#if HAVE_SIGNAL_H+# include <signal.h>+#endif++#if HAVE_TIME_H+# include <time.h>+#endif++#if HAVE_TERMIOS_H+# include <termios.h>+#endif++#if HAVE_STRING_H+# include <string.h>+#endif++#if HAVE_CTYPE_H+# include <ctype.h>+#endif++#if HAVE_INTTYPES_H+# include <inttypes.h>+#else+# if HAVE_STDINT_H+#  include <stdint.h>+# endif+#endif++#if HAVE_SYS_RESOURCE_H+# include <sys/resource.h>+#endif++#include <stdlib.h>+"; then :++else+  fptools_cv_htype_sup_uid_t=no+fi+++                if ac_fn_c_compute_int "$LINENO" "sizeof(uid_t) == sizeof(long double)" "HTYPE_IS_LDOUBLE"        "+#include <stdio.h>+#include <stddef.h>++#if HAVE_SYS_TYPES_H+# include <sys/types.h>+#endif++#if HAVE_UNISTD_H+# include <unistd.h>+#endif++#if HAVE_SYS_STAT_H+# include <sys/stat.h>+#endif++#if HAVE_FCNTL_H+# include <fcntl.h>+#endif++#if HAVE_SIGNAL_H+# include <signal.h>+#endif++#if HAVE_TIME_H+# include <time.h>+#endif++#if HAVE_TERMIOS_H+# include <termios.h>+#endif++#if HAVE_STRING_H+# include <string.h>+#endif++#if HAVE_CTYPE_H+# include <ctype.h>+#endif++#if HAVE_INTTYPES_H+# include <inttypes.h>+#else+# if HAVE_STDINT_H+#  include <stdint.h>+# endif+#endif++#if HAVE_SYS_RESOURCE_H+# include <sys/resource.h>+#endif++#include <stdlib.h>+"; then :++else+  fptools_cv_htype_sup_uid_t=no+fi+++                if test "$HTYPE_IS_FLOAT" -eq 1+                then+                    fptools_cv_htype_uid_t=Float+                elif test "$HTYPE_IS_DOUBLE" -eq 1+                then+                    fptools_cv_htype_uid_t=Double+                elif test "$HTYPE_IS_LDOUBLE" -eq 1+                then+                    fptools_cv_htype_uid_t=LDouble+                else+                    fptools_cv_htype_sup_uid_t=no+                fi+            else+                if ac_fn_c_compute_int "$LINENO" "((uid_t)(-1)) < ((uid_t)0)" "HTYPE_IS_SIGNED"        "+#include <stdio.h>+#include <stddef.h>++#if HAVE_SYS_TYPES_H+# include <sys/types.h>+#endif++#if HAVE_UNISTD_H+# include <unistd.h>+#endif++#if HAVE_SYS_STAT_H+# include <sys/stat.h>+#endif++#if HAVE_FCNTL_H+# include <fcntl.h>+#endif++#if HAVE_SIGNAL_H+# include <signal.h>+#endif++#if HAVE_TIME_H+# include <time.h>+#endif++#if HAVE_TERMIOS_H+# include <termios.h>+#endif++#if HAVE_STRING_H+# include <string.h>+#endif++#if HAVE_CTYPE_H+# include <ctype.h>+#endif++#if HAVE_INTTYPES_H+# include <inttypes.h>+#else+# if HAVE_STDINT_H+#  include <stdint.h>+# endif+#endif++#if HAVE_SYS_RESOURCE_H+# include <sys/resource.h>+#endif++#include <stdlib.h>+"; then :++else+  fptools_cv_htype_sup_uid_t=no+fi+++                if ac_fn_c_compute_int "$LINENO" "sizeof(uid_t) * 8" "HTYPE_SIZE"        "+#include <stdio.h>+#include <stddef.h>++#if HAVE_SYS_TYPES_H+# include <sys/types.h>+#endif++#if HAVE_UNISTD_H+# include <unistd.h>+#endif++#if HAVE_SYS_STAT_H+# include <sys/stat.h>+#endif++#if HAVE_FCNTL_H+# include <fcntl.h>+#endif++#if HAVE_SIGNAL_H+# include <signal.h>+#endif++#if HAVE_TIME_H+# include <time.h>+#endif++#if HAVE_TERMIOS_H+# include <termios.h>+#endif++#if HAVE_STRING_H+# include <string.h>+#endif++#if HAVE_CTYPE_H+# include <ctype.h>+#endif++#if HAVE_INTTYPES_H+# include <inttypes.h>+#else+# if HAVE_STDINT_H+#  include <stdint.h>+# endif+#endif++#if HAVE_SYS_RESOURCE_H+# include <sys/resource.h>+#endif++#include <stdlib.h>+"; then :++else+  fptools_cv_htype_sup_uid_t=no+fi+++                if test "$HTYPE_IS_SIGNED" -eq 0+                then+                    fptools_cv_htype_uid_t="Word$HTYPE_SIZE"+                else+                    fptools_cv_htype_uid_t="Int$HTYPE_SIZE"+                fi+            fi+        fi++fi++    if test "$fptools_cv_htype_sup_uid_t" = no+    then++        fptools_cv_htype_uid_t=NotReallyAType+        { $as_echo "$as_me:${as_lineno-$LINENO}: result: not supported" >&5+$as_echo "not supported" >&6; }++    fi++            if test "$fptools_cv_htype_sup_uid_t" = yes; then+        { $as_echo "$as_me:${as_lineno-$LINENO}: result: $fptools_cv_htype_uid_t" >&5+$as_echo "$fptools_cv_htype_uid_t" >&6; }++cat >>confdefs.h <<_ACEOF+#define HTYPE_UID_T $fptools_cv_htype_uid_t+_ACEOF++    fi+++++++++++    { $as_echo "$as_me:${as_lineno-$LINENO}: checking Haskell type for cc_t" >&5+$as_echo_n "checking Haskell type for cc_t... " >&6; }+    if test "${fptools_cv_htype_cc_t+set}" = set; then :+  $as_echo_n "(cached) " >&6+else++        fptools_cv_htype_sup_cc_t=yes+        if ac_fn_c_compute_int "$LINENO" "((cc_t)((int)((cc_t)1.4))) == ((cc_t)1.4)" "HTYPE_IS_INTEGRAL"        "+#include <stdio.h>+#include <stddef.h>++#if HAVE_SYS_TYPES_H+# include <sys/types.h>+#endif++#if HAVE_UNISTD_H+# include <unistd.h>+#endif++#if HAVE_SYS_STAT_H+# include <sys/stat.h>+#endif++#if HAVE_FCNTL_H+# include <fcntl.h>+#endif++#if HAVE_SIGNAL_H+# include <signal.h>+#endif++#if HAVE_TIME_H+# include <time.h>+#endif++#if HAVE_TERMIOS_H+# include <termios.h>+#endif++#if HAVE_STRING_H+# include <string.h>+#endif++#if HAVE_CTYPE_H+# include <ctype.h>+#endif++#if HAVE_INTTYPES_H+# include <inttypes.h>+#else+# if HAVE_STDINT_H+#  include <stdint.h>+# endif+#endif++#if HAVE_SYS_RESOURCE_H+# include <sys/resource.h>+#endif++#include <stdlib.h>+"; then :++else+  fptools_cv_htype_sup_cc_t=no+fi+++        if test "$fptools_cv_htype_sup_cc_t" = "yes"+        then+            if test "$HTYPE_IS_INTEGRAL" -eq 0+            then+                if ac_fn_c_compute_int "$LINENO" "sizeof(cc_t) == sizeof(float)" "HTYPE_IS_FLOAT"        "+#include <stdio.h>+#include <stddef.h>++#if HAVE_SYS_TYPES_H+# include <sys/types.h>+#endif++#if HAVE_UNISTD_H+# include <unistd.h>+#endif++#if HAVE_SYS_STAT_H+# include <sys/stat.h>+#endif++#if HAVE_FCNTL_H+# include <fcntl.h>+#endif++#if HAVE_SIGNAL_H+# include <signal.h>+#endif++#if HAVE_TIME_H+# include <time.h>+#endif++#if HAVE_TERMIOS_H+# include <termios.h>+#endif++#if HAVE_STRING_H+# include <string.h>+#endif++#if HAVE_CTYPE_H+# include <ctype.h>+#endif++#if HAVE_INTTYPES_H+# include <inttypes.h>+#else+# if HAVE_STDINT_H+#  include <stdint.h>+# endif+#endif++#if HAVE_SYS_RESOURCE_H+# include <sys/resource.h>+#endif++#include <stdlib.h>+"; then :++else+  fptools_cv_htype_sup_cc_t=no+fi+++                if ac_fn_c_compute_int "$LINENO" "sizeof(cc_t) == sizeof(double)" "HTYPE_IS_DOUBLE"        "+#include <stdio.h>+#include <stddef.h>++#if HAVE_SYS_TYPES_H+# include <sys/types.h>+#endif++#if HAVE_UNISTD_H+# include <unistd.h>+#endif++#if HAVE_SYS_STAT_H+# include <sys/stat.h>+#endif++#if HAVE_FCNTL_H+# include <fcntl.h>+#endif++#if HAVE_SIGNAL_H+# include <signal.h>+#endif++#if HAVE_TIME_H+# include <time.h>+#endif++#if HAVE_TERMIOS_H+# include <termios.h>+#endif++#if HAVE_STRING_H+# include <string.h>+#endif++#if HAVE_CTYPE_H+# include <ctype.h>+#endif++#if HAVE_INTTYPES_H+# include <inttypes.h>+#else+# if HAVE_STDINT_H+#  include <stdint.h>+# endif+#endif++#if HAVE_SYS_RESOURCE_H+# include <sys/resource.h>+#endif++#include <stdlib.h>+"; then :++else+  fptools_cv_htype_sup_cc_t=no+fi+++                if ac_fn_c_compute_int "$LINENO" "sizeof(cc_t) == sizeof(long double)" "HTYPE_IS_LDOUBLE"        "+#include <stdio.h>+#include <stddef.h>++#if HAVE_SYS_TYPES_H+# include <sys/types.h>+#endif++#if HAVE_UNISTD_H+# include <unistd.h>+#endif++#if HAVE_SYS_STAT_H+# include <sys/stat.h>+#endif++#if HAVE_FCNTL_H+# include <fcntl.h>+#endif++#if HAVE_SIGNAL_H+# include <signal.h>+#endif++#if HAVE_TIME_H+# include <time.h>+#endif++#if HAVE_TERMIOS_H+# include <termios.h>+#endif++#if HAVE_STRING_H+# include <string.h>+#endif++#if HAVE_CTYPE_H+# include <ctype.h>+#endif++#if HAVE_INTTYPES_H+# include <inttypes.h>+#else+# if HAVE_STDINT_H+#  include <stdint.h>+# endif+#endif++#if HAVE_SYS_RESOURCE_H+# include <sys/resource.h>+#endif++#include <stdlib.h>+"; then :++else+  fptools_cv_htype_sup_cc_t=no+fi+++                if test "$HTYPE_IS_FLOAT" -eq 1+                then+                    fptools_cv_htype_cc_t=Float+                elif test "$HTYPE_IS_DOUBLE" -eq 1+                then+                    fptools_cv_htype_cc_t=Double+                elif test "$HTYPE_IS_LDOUBLE" -eq 1+                then+                    fptools_cv_htype_cc_t=LDouble+                else+                    fptools_cv_htype_sup_cc_t=no+                fi+            else+                if ac_fn_c_compute_int "$LINENO" "((cc_t)(-1)) < ((cc_t)0)" "HTYPE_IS_SIGNED"        "+#include <stdio.h>+#include <stddef.h>++#if HAVE_SYS_TYPES_H+# include <sys/types.h>+#endif++#if HAVE_UNISTD_H+# include <unistd.h>+#endif++#if HAVE_SYS_STAT_H+# include <sys/stat.h>+#endif++#if HAVE_FCNTL_H+# include <fcntl.h>+#endif++#if HAVE_SIGNAL_H+# include <signal.h>+#endif++#if HAVE_TIME_H+# include <time.h>+#endif++#if HAVE_TERMIOS_H+# include <termios.h>+#endif++#if HAVE_STRING_H+# include <string.h>+#endif++#if HAVE_CTYPE_H+# include <ctype.h>+#endif++#if HAVE_INTTYPES_H+# include <inttypes.h>+#else+# if HAVE_STDINT_H+#  include <stdint.h>+# endif+#endif++#if HAVE_SYS_RESOURCE_H+# include <sys/resource.h>+#endif++#include <stdlib.h>+"; then :++else+  fptools_cv_htype_sup_cc_t=no+fi+++                if ac_fn_c_compute_int "$LINENO" "sizeof(cc_t) * 8" "HTYPE_SIZE"        "+#include <stdio.h>+#include <stddef.h>++#if HAVE_SYS_TYPES_H+# include <sys/types.h>+#endif++#if HAVE_UNISTD_H+# include <unistd.h>+#endif++#if HAVE_SYS_STAT_H+# include <sys/stat.h>+#endif++#if HAVE_FCNTL_H+# include <fcntl.h>+#endif++#if HAVE_SIGNAL_H+# include <signal.h>+#endif++#if HAVE_TIME_H+# include <time.h>+#endif++#if HAVE_TERMIOS_H+# include <termios.h>+#endif++#if HAVE_STRING_H+# include <string.h>+#endif++#if HAVE_CTYPE_H+# include <ctype.h>+#endif++#if HAVE_INTTYPES_H+# include <inttypes.h>+#else+# if HAVE_STDINT_H+#  include <stdint.h>+# endif+#endif++#if HAVE_SYS_RESOURCE_H+# include <sys/resource.h>+#endif++#include <stdlib.h>+"; then :++else+  fptools_cv_htype_sup_cc_t=no+fi+++                if test "$HTYPE_IS_SIGNED" -eq 0+                then+                    fptools_cv_htype_cc_t="Word$HTYPE_SIZE"+                else+                    fptools_cv_htype_cc_t="Int$HTYPE_SIZE"+                fi+            fi+        fi++fi++    if test "$fptools_cv_htype_sup_cc_t" = no+    then++        fptools_cv_htype_cc_t=NotReallyAType+        { $as_echo "$as_me:${as_lineno-$LINENO}: result: not supported" >&5+$as_echo "not supported" >&6; }++    fi++            if test "$fptools_cv_htype_sup_cc_t" = yes; then+        { $as_echo "$as_me:${as_lineno-$LINENO}: result: $fptools_cv_htype_cc_t" >&5+$as_echo "$fptools_cv_htype_cc_t" >&6; }++cat >>confdefs.h <<_ACEOF+#define HTYPE_CC_T $fptools_cv_htype_cc_t+_ACEOF++    fi+++++++++++    { $as_echo "$as_me:${as_lineno-$LINENO}: checking Haskell type for speed_t" >&5+$as_echo_n "checking Haskell type for speed_t... " >&6; }+    if test "${fptools_cv_htype_speed_t+set}" = set; then :+  $as_echo_n "(cached) " >&6+else++        fptools_cv_htype_sup_speed_t=yes+        if ac_fn_c_compute_int "$LINENO" "((speed_t)((int)((speed_t)1.4))) == ((speed_t)1.4)" "HTYPE_IS_INTEGRAL"        "+#include <stdio.h>+#include <stddef.h>++#if HAVE_SYS_TYPES_H+# include <sys/types.h>+#endif++#if HAVE_UNISTD_H+# include <unistd.h>+#endif++#if HAVE_SYS_STAT_H+# include <sys/stat.h>+#endif++#if HAVE_FCNTL_H+# include <fcntl.h>+#endif++#if HAVE_SIGNAL_H+# include <signal.h>+#endif++#if HAVE_TIME_H+# include <time.h>+#endif++#if HAVE_TERMIOS_H+# include <termios.h>+#endif++#if HAVE_STRING_H+# include <string.h>+#endif++#if HAVE_CTYPE_H+# include <ctype.h>+#endif++#if HAVE_INTTYPES_H+# include <inttypes.h>+#else+# if HAVE_STDINT_H+#  include <stdint.h>+# endif+#endif++#if HAVE_SYS_RESOURCE_H+# include <sys/resource.h>+#endif++#include <stdlib.h>+"; then :++else+  fptools_cv_htype_sup_speed_t=no+fi+++        if test "$fptools_cv_htype_sup_speed_t" = "yes"+        then+            if test "$HTYPE_IS_INTEGRAL" -eq 0+            then+                if ac_fn_c_compute_int "$LINENO" "sizeof(speed_t) == sizeof(float)" "HTYPE_IS_FLOAT"        "+#include <stdio.h>+#include <stddef.h>++#if HAVE_SYS_TYPES_H+# include <sys/types.h>+#endif++#if HAVE_UNISTD_H+# include <unistd.h>+#endif++#if HAVE_SYS_STAT_H+# include <sys/stat.h>+#endif++#if HAVE_FCNTL_H+# include <fcntl.h>+#endif++#if HAVE_SIGNAL_H+# include <signal.h>+#endif++#if HAVE_TIME_H+# include <time.h>+#endif++#if HAVE_TERMIOS_H+# include <termios.h>+#endif++#if HAVE_STRING_H+# include <string.h>+#endif++#if HAVE_CTYPE_H+# include <ctype.h>+#endif++#if HAVE_INTTYPES_H+# include <inttypes.h>+#else+# if HAVE_STDINT_H+#  include <stdint.h>+# endif+#endif++#if HAVE_SYS_RESOURCE_H+# include <sys/resource.h>+#endif++#include <stdlib.h>+"; then :++else+  fptools_cv_htype_sup_speed_t=no+fi+++                if ac_fn_c_compute_int "$LINENO" "sizeof(speed_t) == sizeof(double)" "HTYPE_IS_DOUBLE"        "+#include <stdio.h>+#include <stddef.h>++#if HAVE_SYS_TYPES_H+# include <sys/types.h>+#endif++#if HAVE_UNISTD_H+# include <unistd.h>+#endif++#if HAVE_SYS_STAT_H+# include <sys/stat.h>+#endif++#if HAVE_FCNTL_H+# include <fcntl.h>+#endif++#if HAVE_SIGNAL_H+# include <signal.h>+#endif++#if HAVE_TIME_H+# include <time.h>+#endif++#if HAVE_TERMIOS_H+# include <termios.h>+#endif++#if HAVE_STRING_H+# include <string.h>+#endif++#if HAVE_CTYPE_H+# include <ctype.h>+#endif++#if HAVE_INTTYPES_H+# include <inttypes.h>+#else+# if HAVE_STDINT_H+#  include <stdint.h>+# endif+#endif++#if HAVE_SYS_RESOURCE_H+# include <sys/resource.h>+#endif++#include <stdlib.h>+"; then :++else+  fptools_cv_htype_sup_speed_t=no+fi+++                if ac_fn_c_compute_int "$LINENO" "sizeof(speed_t) == sizeof(long double)" "HTYPE_IS_LDOUBLE"        "+#include <stdio.h>+#include <stddef.h>++#if HAVE_SYS_TYPES_H+# include <sys/types.h>+#endif++#if HAVE_UNISTD_H+# include <unistd.h>+#endif++#if HAVE_SYS_STAT_H+# include <sys/stat.h>+#endif++#if HAVE_FCNTL_H+# include <fcntl.h>+#endif++#if HAVE_SIGNAL_H+# include <signal.h>+#endif++#if HAVE_TIME_H+# include <time.h>+#endif++#if HAVE_TERMIOS_H+# include <termios.h>+#endif++#if HAVE_STRING_H+# include <string.h>+#endif++#if HAVE_CTYPE_H+# include <ctype.h>+#endif++#if HAVE_INTTYPES_H+# include <inttypes.h>+#else+# if HAVE_STDINT_H+#  include <stdint.h>+# endif+#endif++#if HAVE_SYS_RESOURCE_H+# include <sys/resource.h>+#endif++#include <stdlib.h>+"; then :++else+  fptools_cv_htype_sup_speed_t=no+fi+++                if test "$HTYPE_IS_FLOAT" -eq 1+                then+                    fptools_cv_htype_speed_t=Float+                elif test "$HTYPE_IS_DOUBLE" -eq 1+                then+                    fptools_cv_htype_speed_t=Double+                elif test "$HTYPE_IS_LDOUBLE" -eq 1+                then+                    fptools_cv_htype_speed_t=LDouble+                else+                    fptools_cv_htype_sup_speed_t=no+                fi+            else+                if ac_fn_c_compute_int "$LINENO" "((speed_t)(-1)) < ((speed_t)0)" "HTYPE_IS_SIGNED"        "+#include <stdio.h>+#include <stddef.h>++#if HAVE_SYS_TYPES_H+# include <sys/types.h>+#endif++#if HAVE_UNISTD_H+# include <unistd.h>+#endif++#if HAVE_SYS_STAT_H+# include <sys/stat.h>+#endif++#if HAVE_FCNTL_H+# include <fcntl.h>+#endif++#if HAVE_SIGNAL_H+# include <signal.h>+#endif++#if HAVE_TIME_H+# include <time.h>+#endif++#if HAVE_TERMIOS_H+# include <termios.h>+#endif++#if HAVE_STRING_H+# include <string.h>+#endif++#if HAVE_CTYPE_H+# include <ctype.h>+#endif++#if HAVE_INTTYPES_H+# include <inttypes.h>+#else+# if HAVE_STDINT_H+#  include <stdint.h>+# endif+#endif++#if HAVE_SYS_RESOURCE_H+# include <sys/resource.h>+#endif++#include <stdlib.h>+"; then :++else+  fptools_cv_htype_sup_speed_t=no+fi+++                if ac_fn_c_compute_int "$LINENO" "sizeof(speed_t) * 8" "HTYPE_SIZE"        "+#include <stdio.h>+#include <stddef.h>++#if HAVE_SYS_TYPES_H+# include <sys/types.h>+#endif++#if HAVE_UNISTD_H+# include <unistd.h>+#endif++#if HAVE_SYS_STAT_H+# include <sys/stat.h>+#endif++#if HAVE_FCNTL_H+# include <fcntl.h>+#endif++#if HAVE_SIGNAL_H+# include <signal.h>+#endif++#if HAVE_TIME_H+# include <time.h>+#endif++#if HAVE_TERMIOS_H+# include <termios.h>+#endif++#if HAVE_STRING_H+# include <string.h>+#endif++#if HAVE_CTYPE_H+# include <ctype.h>+#endif++#if HAVE_INTTYPES_H+# include <inttypes.h>+#else+# if HAVE_STDINT_H+#  include <stdint.h>+# endif+#endif++#if HAVE_SYS_RESOURCE_H+# include <sys/resource.h>+#endif++#include <stdlib.h>+"; then :++else+  fptools_cv_htype_sup_speed_t=no+fi+++                if test "$HTYPE_IS_SIGNED" -eq 0+                then+                    fptools_cv_htype_speed_t="Word$HTYPE_SIZE"+                else+                    fptools_cv_htype_speed_t="Int$HTYPE_SIZE"+                fi+            fi+        fi++fi++    if test "$fptools_cv_htype_sup_speed_t" = no+    then++        fptools_cv_htype_speed_t=NotReallyAType+        { $as_echo "$as_me:${as_lineno-$LINENO}: result: not supported" >&5+$as_echo "not supported" >&6; }++    fi++            if test "$fptools_cv_htype_sup_speed_t" = yes; then+        { $as_echo "$as_me:${as_lineno-$LINENO}: result: $fptools_cv_htype_speed_t" >&5+$as_echo "$fptools_cv_htype_speed_t" >&6; }++cat >>confdefs.h <<_ACEOF+#define HTYPE_SPEED_T $fptools_cv_htype_speed_t+_ACEOF++    fi+++++++++++    { $as_echo "$as_me:${as_lineno-$LINENO}: checking Haskell type for tcflag_t" >&5+$as_echo_n "checking Haskell type for tcflag_t... " >&6; }+    if test "${fptools_cv_htype_tcflag_t+set}" = set; then :+  $as_echo_n "(cached) " >&6+else++        fptools_cv_htype_sup_tcflag_t=yes+        if ac_fn_c_compute_int "$LINENO" "((tcflag_t)((int)((tcflag_t)1.4))) == ((tcflag_t)1.4)" "HTYPE_IS_INTEGRAL"        "+#include <stdio.h>+#include <stddef.h>++#if HAVE_SYS_TYPES_H+# include <sys/types.h>+#endif++#if HAVE_UNISTD_H+# include <unistd.h>+#endif++#if HAVE_SYS_STAT_H+# include <sys/stat.h>+#endif++#if HAVE_FCNTL_H+# include <fcntl.h>+#endif++#if HAVE_SIGNAL_H+# include <signal.h>+#endif++#if HAVE_TIME_H+# include <time.h>+#endif++#if HAVE_TERMIOS_H+# include <termios.h>+#endif++#if HAVE_STRING_H+# include <string.h>+#endif++#if HAVE_CTYPE_H+# include <ctype.h>+#endif++#if HAVE_INTTYPES_H+# include <inttypes.h>+#else+# if HAVE_STDINT_H+#  include <stdint.h>+# endif+#endif++#if HAVE_SYS_RESOURCE_H+# include <sys/resource.h>+#endif++#include <stdlib.h>+"; then :++else+  fptools_cv_htype_sup_tcflag_t=no+fi+++        if test "$fptools_cv_htype_sup_tcflag_t" = "yes"+        then+            if test "$HTYPE_IS_INTEGRAL" -eq 0+            then+                if ac_fn_c_compute_int "$LINENO" "sizeof(tcflag_t) == sizeof(float)" "HTYPE_IS_FLOAT"        "+#include <stdio.h>+#include <stddef.h>++#if HAVE_SYS_TYPES_H+# include <sys/types.h>+#endif++#if HAVE_UNISTD_H+# include <unistd.h>+#endif++#if HAVE_SYS_STAT_H+# include <sys/stat.h>+#endif++#if HAVE_FCNTL_H+# include <fcntl.h>+#endif++#if HAVE_SIGNAL_H+# include <signal.h>+#endif++#if HAVE_TIME_H+# include <time.h>+#endif++#if HAVE_TERMIOS_H+# include <termios.h>+#endif++#if HAVE_STRING_H+# include <string.h>+#endif++#if HAVE_CTYPE_H+# include <ctype.h>+#endif++#if HAVE_INTTYPES_H+# include <inttypes.h>+#else+# if HAVE_STDINT_H+#  include <stdint.h>+# endif+#endif++#if HAVE_SYS_RESOURCE_H+# include <sys/resource.h>+#endif++#include <stdlib.h>+"; then :++else+  fptools_cv_htype_sup_tcflag_t=no+fi+++                if ac_fn_c_compute_int "$LINENO" "sizeof(tcflag_t) == sizeof(double)" "HTYPE_IS_DOUBLE"        "+#include <stdio.h>+#include <stddef.h>++#if HAVE_SYS_TYPES_H+# include <sys/types.h>+#endif++#if HAVE_UNISTD_H+# include <unistd.h>+#endif++#if HAVE_SYS_STAT_H+# include <sys/stat.h>+#endif++#if HAVE_FCNTL_H+# include <fcntl.h>+#endif++#if HAVE_SIGNAL_H+# include <signal.h>+#endif++#if HAVE_TIME_H+# include <time.h>+#endif++#if HAVE_TERMIOS_H+# include <termios.h>+#endif++#if HAVE_STRING_H+# include <string.h>+#endif++#if HAVE_CTYPE_H+# include <ctype.h>+#endif++#if HAVE_INTTYPES_H+# include <inttypes.h>+#else+# if HAVE_STDINT_H+#  include <stdint.h>+# endif+#endif++#if HAVE_SYS_RESOURCE_H+# include <sys/resource.h>+#endif++#include <stdlib.h>+"; then :++else+  fptools_cv_htype_sup_tcflag_t=no+fi+++                if ac_fn_c_compute_int "$LINENO" "sizeof(tcflag_t) == sizeof(long double)" "HTYPE_IS_LDOUBLE"        "+#include <stdio.h>+#include <stddef.h>++#if HAVE_SYS_TYPES_H+# include <sys/types.h>+#endif++#if HAVE_UNISTD_H+# include <unistd.h>+#endif++#if HAVE_SYS_STAT_H+# include <sys/stat.h>+#endif++#if HAVE_FCNTL_H+# include <fcntl.h>+#endif++#if HAVE_SIGNAL_H+# include <signal.h>+#endif++#if HAVE_TIME_H+# include <time.h>+#endif++#if HAVE_TERMIOS_H+# include <termios.h>+#endif++#if HAVE_STRING_H+# include <string.h>+#endif++#if HAVE_CTYPE_H+# include <ctype.h>+#endif++#if HAVE_INTTYPES_H+# include <inttypes.h>+#else+# if HAVE_STDINT_H+#  include <stdint.h>+# endif+#endif++#if HAVE_SYS_RESOURCE_H+# include <sys/resource.h>+#endif++#include <stdlib.h>+"; then :++else+  fptools_cv_htype_sup_tcflag_t=no+fi+++                if test "$HTYPE_IS_FLOAT" -eq 1+                then+                    fptools_cv_htype_tcflag_t=Float+                elif test "$HTYPE_IS_DOUBLE" -eq 1+                then+                    fptools_cv_htype_tcflag_t=Double+                elif test "$HTYPE_IS_LDOUBLE" -eq 1+                then+                    fptools_cv_htype_tcflag_t=LDouble+                else+                    fptools_cv_htype_sup_tcflag_t=no+                fi+            else+                if ac_fn_c_compute_int "$LINENO" "((tcflag_t)(-1)) < ((tcflag_t)0)" "HTYPE_IS_SIGNED"        "+#include <stdio.h>+#include <stddef.h>++#if HAVE_SYS_TYPES_H+# include <sys/types.h>+#endif++#if HAVE_UNISTD_H+# include <unistd.h>+#endif++#if HAVE_SYS_STAT_H+# include <sys/stat.h>+#endif++#if HAVE_FCNTL_H+# include <fcntl.h>+#endif++#if HAVE_SIGNAL_H+# include <signal.h>+#endif++#if HAVE_TIME_H+# include <time.h>+#endif++#if HAVE_TERMIOS_H+# include <termios.h>+#endif++#if HAVE_STRING_H+# include <string.h>+#endif++#if HAVE_CTYPE_H+# include <ctype.h>+#endif++#if HAVE_INTTYPES_H+# include <inttypes.h>+#else+# if HAVE_STDINT_H+#  include <stdint.h>+# endif+#endif++#if HAVE_SYS_RESOURCE_H+# include <sys/resource.h>+#endif++#include <stdlib.h>+"; then :++else+  fptools_cv_htype_sup_tcflag_t=no+fi+++                if ac_fn_c_compute_int "$LINENO" "sizeof(tcflag_t) * 8" "HTYPE_SIZE"        "+#include <stdio.h>+#include <stddef.h>++#if HAVE_SYS_TYPES_H+# include <sys/types.h>+#endif++#if HAVE_UNISTD_H+# include <unistd.h>+#endif++#if HAVE_SYS_STAT_H+# include <sys/stat.h>+#endif++#if HAVE_FCNTL_H+# include <fcntl.h>+#endif++#if HAVE_SIGNAL_H+# include <signal.h>+#endif++#if HAVE_TIME_H+# include <time.h>+#endif++#if HAVE_TERMIOS_H+# include <termios.h>+#endif++#if HAVE_STRING_H+# include <string.h>+#endif++#if HAVE_CTYPE_H+# include <ctype.h>+#endif++#if HAVE_INTTYPES_H+# include <inttypes.h>+#else+# if HAVE_STDINT_H+#  include <stdint.h>+# endif+#endif++#if HAVE_SYS_RESOURCE_H+# include <sys/resource.h>+#endif++#include <stdlib.h>+"; then :++else+  fptools_cv_htype_sup_tcflag_t=no+fi+++                if test "$HTYPE_IS_SIGNED" -eq 0+                then+                    fptools_cv_htype_tcflag_t="Word$HTYPE_SIZE"+                else+                    fptools_cv_htype_tcflag_t="Int$HTYPE_SIZE"+                fi+            fi+        fi++fi++    if test "$fptools_cv_htype_sup_tcflag_t" = no+    then++        fptools_cv_htype_tcflag_t=NotReallyAType+        { $as_echo "$as_me:${as_lineno-$LINENO}: result: not supported" >&5+$as_echo "not supported" >&6; }++    fi++            if test "$fptools_cv_htype_sup_tcflag_t" = yes; then+        { $as_echo "$as_me:${as_lineno-$LINENO}: result: $fptools_cv_htype_tcflag_t" >&5+$as_echo "$fptools_cv_htype_tcflag_t" >&6; }++cat >>confdefs.h <<_ACEOF+#define HTYPE_TCFLAG_T $fptools_cv_htype_tcflag_t+_ACEOF++    fi+++++++++++    { $as_echo "$as_me:${as_lineno-$LINENO}: checking Haskell type for nlink_t" >&5+$as_echo_n "checking Haskell type for nlink_t... " >&6; }+    if test "${fptools_cv_htype_nlink_t+set}" = set; then :+  $as_echo_n "(cached) " >&6+else++        fptools_cv_htype_sup_nlink_t=yes+        if ac_fn_c_compute_int "$LINENO" "((nlink_t)((int)((nlink_t)1.4))) == ((nlink_t)1.4)" "HTYPE_IS_INTEGRAL"        "+#include <stdio.h>+#include <stddef.h>++#if HAVE_SYS_TYPES_H+# include <sys/types.h>+#endif++#if HAVE_UNISTD_H+# include <unistd.h>+#endif++#if HAVE_SYS_STAT_H+# include <sys/stat.h>+#endif++#if HAVE_FCNTL_H+# include <fcntl.h>+#endif++#if HAVE_SIGNAL_H+# include <signal.h>+#endif++#if HAVE_TIME_H+# include <time.h>+#endif++#if HAVE_TERMIOS_H+# include <termios.h>+#endif++#if HAVE_STRING_H+# include <string.h>+#endif++#if HAVE_CTYPE_H+# include <ctype.h>+#endif++#if HAVE_INTTYPES_H+# include <inttypes.h>+#else+# if HAVE_STDINT_H+#  include <stdint.h>+# endif+#endif++#if HAVE_SYS_RESOURCE_H+# include <sys/resource.h>+#endif++#include <stdlib.h>+"; then :++else+  fptools_cv_htype_sup_nlink_t=no+fi+++        if test "$fptools_cv_htype_sup_nlink_t" = "yes"+        then+            if test "$HTYPE_IS_INTEGRAL" -eq 0+            then+                if ac_fn_c_compute_int "$LINENO" "sizeof(nlink_t) == sizeof(float)" "HTYPE_IS_FLOAT"        "+#include <stdio.h>+#include <stddef.h>++#if HAVE_SYS_TYPES_H+# include <sys/types.h>+#endif++#if HAVE_UNISTD_H+# include <unistd.h>+#endif++#if HAVE_SYS_STAT_H+# include <sys/stat.h>+#endif++#if HAVE_FCNTL_H+# include <fcntl.h>+#endif++#if HAVE_SIGNAL_H+# include <signal.h>+#endif++#if HAVE_TIME_H+# include <time.h>+#endif++#if HAVE_TERMIOS_H+# include <termios.h>+#endif++#if HAVE_STRING_H+# include <string.h>+#endif++#if HAVE_CTYPE_H+# include <ctype.h>+#endif++#if HAVE_INTTYPES_H+# include <inttypes.h>+#else+# if HAVE_STDINT_H+#  include <stdint.h>+# endif+#endif++#if HAVE_SYS_RESOURCE_H+# include <sys/resource.h>+#endif++#include <stdlib.h>+"; then :++else+  fptools_cv_htype_sup_nlink_t=no+fi+++                if ac_fn_c_compute_int "$LINENO" "sizeof(nlink_t) == sizeof(double)" "HTYPE_IS_DOUBLE"        "+#include <stdio.h>+#include <stddef.h>++#if HAVE_SYS_TYPES_H+# include <sys/types.h>+#endif++#if HAVE_UNISTD_H+# include <unistd.h>+#endif++#if HAVE_SYS_STAT_H+# include <sys/stat.h>+#endif++#if HAVE_FCNTL_H+# include <fcntl.h>+#endif++#if HAVE_SIGNAL_H+# include <signal.h>+#endif++#if HAVE_TIME_H+# include <time.h>+#endif++#if HAVE_TERMIOS_H+# include <termios.h>+#endif++#if HAVE_STRING_H+# include <string.h>+#endif++#if HAVE_CTYPE_H+# include <ctype.h>+#endif++#if HAVE_INTTYPES_H+# include <inttypes.h>+#else+# if HAVE_STDINT_H+#  include <stdint.h>+# endif+#endif++#if HAVE_SYS_RESOURCE_H+# include <sys/resource.h>+#endif++#include <stdlib.h>+"; then :++else+  fptools_cv_htype_sup_nlink_t=no+fi+++                if ac_fn_c_compute_int "$LINENO" "sizeof(nlink_t) == sizeof(long double)" "HTYPE_IS_LDOUBLE"        "+#include <stdio.h>+#include <stddef.h>++#if HAVE_SYS_TYPES_H+# include <sys/types.h>+#endif++#if HAVE_UNISTD_H+# include <unistd.h>+#endif++#if HAVE_SYS_STAT_H+# include <sys/stat.h>+#endif++#if HAVE_FCNTL_H+# include <fcntl.h>+#endif++#if HAVE_SIGNAL_H+# include <signal.h>+#endif++#if HAVE_TIME_H+# include <time.h>+#endif++#if HAVE_TERMIOS_H+# include <termios.h>+#endif++#if HAVE_STRING_H+# include <string.h>+#endif++#if HAVE_CTYPE_H+# include <ctype.h>+#endif++#if HAVE_INTTYPES_H+# include <inttypes.h>+#else+# if HAVE_STDINT_H+#  include <stdint.h>+# endif+#endif++#if HAVE_SYS_RESOURCE_H+# include <sys/resource.h>+#endif++#include <stdlib.h>+"; then :++else+  fptools_cv_htype_sup_nlink_t=no+fi+++                if test "$HTYPE_IS_FLOAT" -eq 1+                then+                    fptools_cv_htype_nlink_t=Float+                elif test "$HTYPE_IS_DOUBLE" -eq 1+                then+                    fptools_cv_htype_nlink_t=Double+                elif test "$HTYPE_IS_LDOUBLE" -eq 1+                then+                    fptools_cv_htype_nlink_t=LDouble+                else+                    fptools_cv_htype_sup_nlink_t=no+                fi+            else+                if ac_fn_c_compute_int "$LINENO" "((nlink_t)(-1)) < ((nlink_t)0)" "HTYPE_IS_SIGNED"        "+#include <stdio.h>+#include <stddef.h>++#if HAVE_SYS_TYPES_H+# include <sys/types.h>+#endif++#if HAVE_UNISTD_H+# include <unistd.h>+#endif++#if HAVE_SYS_STAT_H+# include <sys/stat.h>+#endif++#if HAVE_FCNTL_H+# include <fcntl.h>+#endif++#if HAVE_SIGNAL_H+# include <signal.h>+#endif++#if HAVE_TIME_H+# include <time.h>+#endif++#if HAVE_TERMIOS_H+# include <termios.h>+#endif++#if HAVE_STRING_H+# include <string.h>+#endif++#if HAVE_CTYPE_H+# include <ctype.h>+#endif++#if HAVE_INTTYPES_H+# include <inttypes.h>+#else+# if HAVE_STDINT_H+#  include <stdint.h>+# endif+#endif++#if HAVE_SYS_RESOURCE_H+# include <sys/resource.h>+#endif++#include <stdlib.h>+"; then :++else+  fptools_cv_htype_sup_nlink_t=no+fi+++                if ac_fn_c_compute_int "$LINENO" "sizeof(nlink_t) * 8" "HTYPE_SIZE"        "+#include <stdio.h>+#include <stddef.h>++#if HAVE_SYS_TYPES_H+# include <sys/types.h>+#endif++#if HAVE_UNISTD_H+# include <unistd.h>+#endif++#if HAVE_SYS_STAT_H+# include <sys/stat.h>+#endif++#if HAVE_FCNTL_H+# include <fcntl.h>+#endif++#if HAVE_SIGNAL_H+# include <signal.h>+#endif++#if HAVE_TIME_H+# include <time.h>+#endif++#if HAVE_TERMIOS_H+# include <termios.h>+#endif++#if HAVE_STRING_H+# include <string.h>+#endif++#if HAVE_CTYPE_H+# include <ctype.h>+#endif++#if HAVE_INTTYPES_H+# include <inttypes.h>+#else+# if HAVE_STDINT_H+#  include <stdint.h>+# endif+#endif++#if HAVE_SYS_RESOURCE_H+# include <sys/resource.h>+#endif++#include <stdlib.h>+"; then :++else+  fptools_cv_htype_sup_nlink_t=no+fi+++                if test "$HTYPE_IS_SIGNED" -eq 0+                then+                    fptools_cv_htype_nlink_t="Word$HTYPE_SIZE"+                else+                    fptools_cv_htype_nlink_t="Int$HTYPE_SIZE"+                fi+            fi+        fi++fi++    if test "$fptools_cv_htype_sup_nlink_t" = no+    then++        fptools_cv_htype_nlink_t=NotReallyAType+        { $as_echo "$as_me:${as_lineno-$LINENO}: result: not supported" >&5+$as_echo "not supported" >&6; }++    fi++            if test "$fptools_cv_htype_sup_nlink_t" = yes; then+        { $as_echo "$as_me:${as_lineno-$LINENO}: result: $fptools_cv_htype_nlink_t" >&5+$as_echo "$fptools_cv_htype_nlink_t" >&6; }++cat >>confdefs.h <<_ACEOF+#define HTYPE_NLINK_T $fptools_cv_htype_nlink_t+_ACEOF++    fi+++++++++++    { $as_echo "$as_me:${as_lineno-$LINENO}: checking Haskell type for ssize_t" >&5+$as_echo_n "checking Haskell type for ssize_t... " >&6; }+    if test "${fptools_cv_htype_ssize_t+set}" = set; then :+  $as_echo_n "(cached) " >&6+else++        fptools_cv_htype_sup_ssize_t=yes+        if ac_fn_c_compute_int "$LINENO" "((ssize_t)((int)((ssize_t)1.4))) == ((ssize_t)1.4)" "HTYPE_IS_INTEGRAL"        "+#include <stdio.h>+#include <stddef.h>++#if HAVE_SYS_TYPES_H+# include <sys/types.h>+#endif++#if HAVE_UNISTD_H+# include <unistd.h>+#endif++#if HAVE_SYS_STAT_H+# include <sys/stat.h>+#endif++#if HAVE_FCNTL_H+# include <fcntl.h>+#endif++#if HAVE_SIGNAL_H+# include <signal.h>+#endif++#if HAVE_TIME_H+# include <time.h>+#endif++#if HAVE_TERMIOS_H+# include <termios.h>+#endif++#if HAVE_STRING_H+# include <string.h>+#endif++#if HAVE_CTYPE_H+# include <ctype.h>+#endif++#if HAVE_INTTYPES_H+# include <inttypes.h>+#else+# if HAVE_STDINT_H+#  include <stdint.h>+# endif+#endif++#if HAVE_SYS_RESOURCE_H+# include <sys/resource.h>+#endif++#include <stdlib.h>+"; then :++else+  fptools_cv_htype_sup_ssize_t=no+fi+++        if test "$fptools_cv_htype_sup_ssize_t" = "yes"+        then+            if test "$HTYPE_IS_INTEGRAL" -eq 0+            then+                if ac_fn_c_compute_int "$LINENO" "sizeof(ssize_t) == sizeof(float)" "HTYPE_IS_FLOAT"        "+#include <stdio.h>+#include <stddef.h>++#if HAVE_SYS_TYPES_H+# include <sys/types.h>+#endif++#if HAVE_UNISTD_H+# include <unistd.h>+#endif++#if HAVE_SYS_STAT_H+# include <sys/stat.h>+#endif++#if HAVE_FCNTL_H+# include <fcntl.h>+#endif++#if HAVE_SIGNAL_H+# include <signal.h>+#endif++#if HAVE_TIME_H+# include <time.h>+#endif++#if HAVE_TERMIOS_H+# include <termios.h>+#endif++#if HAVE_STRING_H+# include <string.h>+#endif++#if HAVE_CTYPE_H+# include <ctype.h>+#endif++#if HAVE_INTTYPES_H+# include <inttypes.h>+#else+# if HAVE_STDINT_H+#  include <stdint.h>+# endif+#endif++#if HAVE_SYS_RESOURCE_H+# include <sys/resource.h>+#endif++#include <stdlib.h>+"; then :++else+  fptools_cv_htype_sup_ssize_t=no+fi+++                if ac_fn_c_compute_int "$LINENO" "sizeof(ssize_t) == sizeof(double)" "HTYPE_IS_DOUBLE"        "+#include <stdio.h>+#include <stddef.h>++#if HAVE_SYS_TYPES_H+# include <sys/types.h>+#endif++#if HAVE_UNISTD_H+# include <unistd.h>+#endif++#if HAVE_SYS_STAT_H+# include <sys/stat.h>+#endif++#if HAVE_FCNTL_H+# include <fcntl.h>+#endif++#if HAVE_SIGNAL_H+# include <signal.h>+#endif++#if HAVE_TIME_H+# include <time.h>+#endif++#if HAVE_TERMIOS_H+# include <termios.h>+#endif++#if HAVE_STRING_H+# include <string.h>+#endif++#if HAVE_CTYPE_H+# include <ctype.h>+#endif++#if HAVE_INTTYPES_H+# include <inttypes.h>+#else+# if HAVE_STDINT_H+#  include <stdint.h>+# endif+#endif++#if HAVE_SYS_RESOURCE_H+# include <sys/resource.h>+#endif++#include <stdlib.h>+"; then :++else+  fptools_cv_htype_sup_ssize_t=no+fi+++                if ac_fn_c_compute_int "$LINENO" "sizeof(ssize_t) == sizeof(long double)" "HTYPE_IS_LDOUBLE"        "+#include <stdio.h>+#include <stddef.h>++#if HAVE_SYS_TYPES_H+# include <sys/types.h>+#endif++#if HAVE_UNISTD_H+# include <unistd.h>+#endif++#if HAVE_SYS_STAT_H+# include <sys/stat.h>+#endif++#if HAVE_FCNTL_H+# include <fcntl.h>+#endif++#if HAVE_SIGNAL_H+# include <signal.h>+#endif++#if HAVE_TIME_H+# include <time.h>+#endif++#if HAVE_TERMIOS_H+# include <termios.h>+#endif++#if HAVE_STRING_H+# include <string.h>+#endif++#if HAVE_CTYPE_H+# include <ctype.h>+#endif++#if HAVE_INTTYPES_H+# include <inttypes.h>+#else+# if HAVE_STDINT_H+#  include <stdint.h>+# endif+#endif++#if HAVE_SYS_RESOURCE_H+# include <sys/resource.h>+#endif++#include <stdlib.h>+"; then :++else+  fptools_cv_htype_sup_ssize_t=no+fi+++                if test "$HTYPE_IS_FLOAT" -eq 1+                then+                    fptools_cv_htype_ssize_t=Float+                elif test "$HTYPE_IS_DOUBLE" -eq 1+                then+                    fptools_cv_htype_ssize_t=Double+                elif test "$HTYPE_IS_LDOUBLE" -eq 1+                then+                    fptools_cv_htype_ssize_t=LDouble+                else+                    fptools_cv_htype_sup_ssize_t=no+                fi+            else+                if ac_fn_c_compute_int "$LINENO" "((ssize_t)(-1)) < ((ssize_t)0)" "HTYPE_IS_SIGNED"        "+#include <stdio.h>+#include <stddef.h>++#if HAVE_SYS_TYPES_H+# include <sys/types.h>+#endif++#if HAVE_UNISTD_H+# include <unistd.h>+#endif++#if HAVE_SYS_STAT_H+# include <sys/stat.h>+#endif++#if HAVE_FCNTL_H+# include <fcntl.h>+#endif++#if HAVE_SIGNAL_H+# include <signal.h>+#endif++#if HAVE_TIME_H+# include <time.h>+#endif++#if HAVE_TERMIOS_H+# include <termios.h>+#endif++#if HAVE_STRING_H+# include <string.h>+#endif++#if HAVE_CTYPE_H+# include <ctype.h>+#endif++#if HAVE_INTTYPES_H+# include <inttypes.h>+#else+# if HAVE_STDINT_H+#  include <stdint.h>+# endif+#endif++#if HAVE_SYS_RESOURCE_H+# include <sys/resource.h>+#endif++#include <stdlib.h>+"; then :++else+  fptools_cv_htype_sup_ssize_t=no+fi+++                if ac_fn_c_compute_int "$LINENO" "sizeof(ssize_t) * 8" "HTYPE_SIZE"        "+#include <stdio.h>+#include <stddef.h>++#if HAVE_SYS_TYPES_H+# include <sys/types.h>+#endif++#if HAVE_UNISTD_H+# include <unistd.h>+#endif++#if HAVE_SYS_STAT_H+# include <sys/stat.h>+#endif++#if HAVE_FCNTL_H+# include <fcntl.h>+#endif++#if HAVE_SIGNAL_H+# include <signal.h>+#endif++#if HAVE_TIME_H+# include <time.h>+#endif++#if HAVE_TERMIOS_H+# include <termios.h>+#endif++#if HAVE_STRING_H+# include <string.h>+#endif++#if HAVE_CTYPE_H+# include <ctype.h>+#endif++#if HAVE_INTTYPES_H+# include <inttypes.h>+#else+# if HAVE_STDINT_H+#  include <stdint.h>+# endif+#endif++#if HAVE_SYS_RESOURCE_H+# include <sys/resource.h>+#endif++#include <stdlib.h>+"; then :++else+  fptools_cv_htype_sup_ssize_t=no+fi+++                if test "$HTYPE_IS_SIGNED" -eq 0+                then+                    fptools_cv_htype_ssize_t="Word$HTYPE_SIZE"+                else+                    fptools_cv_htype_ssize_t="Int$HTYPE_SIZE"+                fi+            fi+        fi++fi++    if test "$fptools_cv_htype_sup_ssize_t" = no+    then++        fptools_cv_htype_ssize_t=NotReallyAType+        { $as_echo "$as_me:${as_lineno-$LINENO}: result: not supported" >&5+$as_echo "not supported" >&6; }++    fi++            if test "$fptools_cv_htype_sup_ssize_t" = yes; then+        { $as_echo "$as_me:${as_lineno-$LINENO}: result: $fptools_cv_htype_ssize_t" >&5+$as_echo "$fptools_cv_htype_ssize_t" >&6; }++cat >>confdefs.h <<_ACEOF+#define HTYPE_SSIZE_T $fptools_cv_htype_ssize_t+_ACEOF++    fi+++++++++++    { $as_echo "$as_me:${as_lineno-$LINENO}: checking Haskell type for rlim_t" >&5+$as_echo_n "checking Haskell type for rlim_t... " >&6; }+    if test "${fptools_cv_htype_rlim_t+set}" = set; then :+  $as_echo_n "(cached) " >&6+else++        fptools_cv_htype_sup_rlim_t=yes+        if ac_fn_c_compute_int "$LINENO" "((rlim_t)((int)((rlim_t)1.4))) == ((rlim_t)1.4)" "HTYPE_IS_INTEGRAL"        "+#include <stdio.h>+#include <stddef.h>++#if HAVE_SYS_TYPES_H+# include <sys/types.h>+#endif++#if HAVE_UNISTD_H+# include <unistd.h>+#endif++#if HAVE_SYS_STAT_H+# include <sys/stat.h>+#endif++#if HAVE_FCNTL_H+# include <fcntl.h>+#endif++#if HAVE_SIGNAL_H+# include <signal.h>+#endif++#if HAVE_TIME_H+# include <time.h>+#endif++#if HAVE_TERMIOS_H+# include <termios.h>+#endif++#if HAVE_STRING_H+# include <string.h>+#endif++#if HAVE_CTYPE_H+# include <ctype.h>+#endif++#if HAVE_INTTYPES_H+# include <inttypes.h>+#else+# if HAVE_STDINT_H+#  include <stdint.h>+# endif+#endif++#if HAVE_SYS_RESOURCE_H+# include <sys/resource.h>+#endif++#include <stdlib.h>+"; then :++else+  fptools_cv_htype_sup_rlim_t=no+fi+++        if test "$fptools_cv_htype_sup_rlim_t" = "yes"+        then+            if test "$HTYPE_IS_INTEGRAL" -eq 0+            then+                if ac_fn_c_compute_int "$LINENO" "sizeof(rlim_t) == sizeof(float)" "HTYPE_IS_FLOAT"        "+#include <stdio.h>+#include <stddef.h>++#if HAVE_SYS_TYPES_H+# include <sys/types.h>+#endif++#if HAVE_UNISTD_H+# include <unistd.h>+#endif++#if HAVE_SYS_STAT_H+# include <sys/stat.h>+#endif++#if HAVE_FCNTL_H+# include <fcntl.h>+#endif++#if HAVE_SIGNAL_H+# include <signal.h>+#endif++#if HAVE_TIME_H+# include <time.h>+#endif++#if HAVE_TERMIOS_H+# include <termios.h>+#endif++#if HAVE_STRING_H+# include <string.h>+#endif++#if HAVE_CTYPE_H+# include <ctype.h>+#endif++#if HAVE_INTTYPES_H+# include <inttypes.h>+#else+# if HAVE_STDINT_H+#  include <stdint.h>+# endif+#endif++#if HAVE_SYS_RESOURCE_H+# include <sys/resource.h>+#endif++#include <stdlib.h>+"; then :++else+  fptools_cv_htype_sup_rlim_t=no+fi+++                if ac_fn_c_compute_int "$LINENO" "sizeof(rlim_t) == sizeof(double)" "HTYPE_IS_DOUBLE"        "+#include <stdio.h>+#include <stddef.h>++#if HAVE_SYS_TYPES_H+# include <sys/types.h>+#endif++#if HAVE_UNISTD_H+# include <unistd.h>+#endif++#if HAVE_SYS_STAT_H+# include <sys/stat.h>+#endif++#if HAVE_FCNTL_H+# include <fcntl.h>+#endif++#if HAVE_SIGNAL_H+# include <signal.h>+#endif++#if HAVE_TIME_H+# include <time.h>+#endif++#if HAVE_TERMIOS_H+# include <termios.h>+#endif++#if HAVE_STRING_H+# include <string.h>+#endif++#if HAVE_CTYPE_H+# include <ctype.h>+#endif++#if HAVE_INTTYPES_H+# include <inttypes.h>+#else+# if HAVE_STDINT_H+#  include <stdint.h>+# endif+#endif++#if HAVE_SYS_RESOURCE_H+# include <sys/resource.h>+#endif++#include <stdlib.h>+"; then :++else+  fptools_cv_htype_sup_rlim_t=no+fi+++                if ac_fn_c_compute_int "$LINENO" "sizeof(rlim_t) == sizeof(long double)" "HTYPE_IS_LDOUBLE"        "+#include <stdio.h>+#include <stddef.h>++#if HAVE_SYS_TYPES_H+# include <sys/types.h>+#endif++#if HAVE_UNISTD_H+# include <unistd.h>+#endif++#if HAVE_SYS_STAT_H+# include <sys/stat.h>+#endif++#if HAVE_FCNTL_H+# include <fcntl.h>+#endif++#if HAVE_SIGNAL_H+# include <signal.h>+#endif++#if HAVE_TIME_H+# include <time.h>+#endif++#if HAVE_TERMIOS_H+# include <termios.h>+#endif++#if HAVE_STRING_H+# include <string.h>+#endif++#if HAVE_CTYPE_H+# include <ctype.h>+#endif++#if HAVE_INTTYPES_H+# include <inttypes.h>+#else+# if HAVE_STDINT_H+#  include <stdint.h>+# endif+#endif++#if HAVE_SYS_RESOURCE_H+# include <sys/resource.h>+#endif++#include <stdlib.h>+"; then :++else+  fptools_cv_htype_sup_rlim_t=no+fi+++                if test "$HTYPE_IS_FLOAT" -eq 1+                then+                    fptools_cv_htype_rlim_t=Float+                elif test "$HTYPE_IS_DOUBLE" -eq 1+                then+                    fptools_cv_htype_rlim_t=Double+                elif test "$HTYPE_IS_LDOUBLE" -eq 1+                then+                    fptools_cv_htype_rlim_t=LDouble+                else+                    fptools_cv_htype_sup_rlim_t=no+                fi+            else+                if ac_fn_c_compute_int "$LINENO" "((rlim_t)(-1)) < ((rlim_t)0)" "HTYPE_IS_SIGNED"        "+#include <stdio.h>+#include <stddef.h>++#if HAVE_SYS_TYPES_H+# include <sys/types.h>+#endif++#if HAVE_UNISTD_H+# include <unistd.h>+#endif++#if HAVE_SYS_STAT_H+# include <sys/stat.h>+#endif++#if HAVE_FCNTL_H+# include <fcntl.h>+#endif++#if HAVE_SIGNAL_H+# include <signal.h>+#endif++#if HAVE_TIME_H+# include <time.h>+#endif++#if HAVE_TERMIOS_H+# include <termios.h>+#endif++#if HAVE_STRING_H+# include <string.h>+#endif++#if HAVE_CTYPE_H+# include <ctype.h>+#endif++#if HAVE_INTTYPES_H+# include <inttypes.h>+#else+# if HAVE_STDINT_H+#  include <stdint.h>+# endif+#endif++#if HAVE_SYS_RESOURCE_H+# include <sys/resource.h>+#endif++#include <stdlib.h>+"; then :++else+  fptools_cv_htype_sup_rlim_t=no+fi+++                if ac_fn_c_compute_int "$LINENO" "sizeof(rlim_t) * 8" "HTYPE_SIZE"        "+#include <stdio.h>+#include <stddef.h>++#if HAVE_SYS_TYPES_H+# include <sys/types.h>+#endif++#if HAVE_UNISTD_H+# include <unistd.h>+#endif++#if HAVE_SYS_STAT_H+# include <sys/stat.h>+#endif++#if HAVE_FCNTL_H+# include <fcntl.h>+#endif++#if HAVE_SIGNAL_H+# include <signal.h>+#endif++#if HAVE_TIME_H+# include <time.h>+#endif++#if HAVE_TERMIOS_H+# include <termios.h>+#endif++#if HAVE_STRING_H+# include <string.h>+#endif++#if HAVE_CTYPE_H+# include <ctype.h>+#endif++#if HAVE_INTTYPES_H+# include <inttypes.h>+#else+# if HAVE_STDINT_H+#  include <stdint.h>+# endif+#endif++#if HAVE_SYS_RESOURCE_H+# include <sys/resource.h>+#endif++#include <stdlib.h>+"; then :++else+  fptools_cv_htype_sup_rlim_t=no+fi+++                if test "$HTYPE_IS_SIGNED" -eq 0+                then+                    fptools_cv_htype_rlim_t="Word$HTYPE_SIZE"+                else+                    fptools_cv_htype_rlim_t="Int$HTYPE_SIZE"+                fi+            fi+        fi++fi++    if test "$fptools_cv_htype_sup_rlim_t" = no+    then++        fptools_cv_htype_rlim_t=NotReallyAType+        { $as_echo "$as_me:${as_lineno-$LINENO}: result: not supported" >&5+$as_echo "not supported" >&6; }++    fi++            if test "$fptools_cv_htype_sup_rlim_t" = yes; then+        { $as_echo "$as_me:${as_lineno-$LINENO}: result: $fptools_cv_htype_rlim_t" >&5+$as_echo "$fptools_cv_htype_rlim_t" >&6; }++cat >>confdefs.h <<_ACEOF+#define HTYPE_RLIM_T $fptools_cv_htype_rlim_t+_ACEOF++    fi++++++++++++    { $as_echo "$as_me:${as_lineno-$LINENO}: checking Haskell type for intptr_t" >&5+$as_echo_n "checking Haskell type for intptr_t... " >&6; }+    if test "${fptools_cv_htype_intptr_t+set}" = set; then :+  $as_echo_n "(cached) " >&6+else++        fptools_cv_htype_sup_intptr_t=yes+        if ac_fn_c_compute_int "$LINENO" "((intptr_t)((int)((intptr_t)1.4))) == ((intptr_t)1.4)" "HTYPE_IS_INTEGRAL"        "+#include <stdio.h>+#include <stddef.h>++#if HAVE_SYS_TYPES_H+# include <sys/types.h>+#endif++#if HAVE_UNISTD_H+# include <unistd.h>+#endif++#if HAVE_SYS_STAT_H+# include <sys/stat.h>+#endif++#if HAVE_FCNTL_H+# include <fcntl.h>+#endif++#if HAVE_SIGNAL_H+# include <signal.h>+#endif++#if HAVE_TIME_H+# include <time.h>+#endif++#if HAVE_TERMIOS_H+# include <termios.h>+#endif++#if HAVE_STRING_H+# include <string.h>+#endif++#if HAVE_CTYPE_H+# include <ctype.h>+#endif++#if HAVE_INTTYPES_H+# include <inttypes.h>+#else+# if HAVE_STDINT_H+#  include <stdint.h>+# endif+#endif++#if HAVE_SYS_RESOURCE_H+# include <sys/resource.h>+#endif++#include <stdlib.h>+"; then :++else+  fptools_cv_htype_sup_intptr_t=no+fi+++        if test "$fptools_cv_htype_sup_intptr_t" = "yes"+        then+            if test "$HTYPE_IS_INTEGRAL" -eq 0+            then+                if ac_fn_c_compute_int "$LINENO" "sizeof(intptr_t) == sizeof(float)" "HTYPE_IS_FLOAT"        "+#include <stdio.h>+#include <stddef.h>++#if HAVE_SYS_TYPES_H+# include <sys/types.h>+#endif++#if HAVE_UNISTD_H+# include <unistd.h>+#endif++#if HAVE_SYS_STAT_H+# include <sys/stat.h>+#endif++#if HAVE_FCNTL_H+# include <fcntl.h>+#endif++#if HAVE_SIGNAL_H+# include <signal.h>+#endif++#if HAVE_TIME_H+# include <time.h>+#endif++#if HAVE_TERMIOS_H+# include <termios.h>+#endif++#if HAVE_STRING_H+# include <string.h>+#endif++#if HAVE_CTYPE_H+# include <ctype.h>+#endif++#if HAVE_INTTYPES_H+# include <inttypes.h>+#else+# if HAVE_STDINT_H+#  include <stdint.h>+# endif+#endif++#if HAVE_SYS_RESOURCE_H+# include <sys/resource.h>+#endif++#include <stdlib.h>+"; then :++else+  fptools_cv_htype_sup_intptr_t=no+fi+++                if ac_fn_c_compute_int "$LINENO" "sizeof(intptr_t) == sizeof(double)" "HTYPE_IS_DOUBLE"        "+#include <stdio.h>+#include <stddef.h>++#if HAVE_SYS_TYPES_H+# include <sys/types.h>+#endif++#if HAVE_UNISTD_H+# include <unistd.h>+#endif++#if HAVE_SYS_STAT_H+# include <sys/stat.h>+#endif++#if HAVE_FCNTL_H+# include <fcntl.h>+#endif++#if HAVE_SIGNAL_H+# include <signal.h>+#endif++#if HAVE_TIME_H+# include <time.h>+#endif++#if HAVE_TERMIOS_H+# include <termios.h>+#endif++#if HAVE_STRING_H+# include <string.h>+#endif++#if HAVE_CTYPE_H+# include <ctype.h>+#endif++#if HAVE_INTTYPES_H+# include <inttypes.h>+#else+# if HAVE_STDINT_H+#  include <stdint.h>+# endif+#endif++#if HAVE_SYS_RESOURCE_H+# include <sys/resource.h>+#endif++#include <stdlib.h>+"; then :++else+  fptools_cv_htype_sup_intptr_t=no+fi+++                if ac_fn_c_compute_int "$LINENO" "sizeof(intptr_t) == sizeof(long double)" "HTYPE_IS_LDOUBLE"        "+#include <stdio.h>+#include <stddef.h>++#if HAVE_SYS_TYPES_H+# include <sys/types.h>+#endif++#if HAVE_UNISTD_H+# include <unistd.h>+#endif++#if HAVE_SYS_STAT_H+# include <sys/stat.h>+#endif++#if HAVE_FCNTL_H+# include <fcntl.h>+#endif++#if HAVE_SIGNAL_H+# include <signal.h>+#endif++#if HAVE_TIME_H+# include <time.h>+#endif++#if HAVE_TERMIOS_H+# include <termios.h>+#endif++#if HAVE_STRING_H+# include <string.h>+#endif++#if HAVE_CTYPE_H+# include <ctype.h>+#endif++#if HAVE_INTTYPES_H+# include <inttypes.h>+#else+# if HAVE_STDINT_H+#  include <stdint.h>+# endif+#endif++#if HAVE_SYS_RESOURCE_H+# include <sys/resource.h>+#endif++#include <stdlib.h>+"; then :++else+  fptools_cv_htype_sup_intptr_t=no+fi+++                if test "$HTYPE_IS_FLOAT" -eq 1+                then+                    fptools_cv_htype_intptr_t=Float+                elif test "$HTYPE_IS_DOUBLE" -eq 1+                then+                    fptools_cv_htype_intptr_t=Double+                elif test "$HTYPE_IS_LDOUBLE" -eq 1+                then+                    fptools_cv_htype_intptr_t=LDouble+                else+                    fptools_cv_htype_sup_intptr_t=no+                fi+            else+                if ac_fn_c_compute_int "$LINENO" "((intptr_t)(-1)) < ((intptr_t)0)" "HTYPE_IS_SIGNED"        "+#include <stdio.h>+#include <stddef.h>++#if HAVE_SYS_TYPES_H+# include <sys/types.h>+#endif++#if HAVE_UNISTD_H+# include <unistd.h>+#endif++#if HAVE_SYS_STAT_H+# include <sys/stat.h>+#endif++#if HAVE_FCNTL_H+# include <fcntl.h>+#endif++#if HAVE_SIGNAL_H+# include <signal.h>+#endif++#if HAVE_TIME_H+# include <time.h>+#endif++#if HAVE_TERMIOS_H+# include <termios.h>+#endif++#if HAVE_STRING_H+# include <string.h>+#endif++#if HAVE_CTYPE_H+# include <ctype.h>+#endif++#if HAVE_INTTYPES_H+# include <inttypes.h>+#else+# if HAVE_STDINT_H+#  include <stdint.h>+# endif+#endif++#if HAVE_SYS_RESOURCE_H+# include <sys/resource.h>+#endif++#include <stdlib.h>+"; then :++else+  fptools_cv_htype_sup_intptr_t=no+fi+++                if ac_fn_c_compute_int "$LINENO" "sizeof(intptr_t) * 8" "HTYPE_SIZE"        "+#include <stdio.h>+#include <stddef.h>++#if HAVE_SYS_TYPES_H+# include <sys/types.h>+#endif++#if HAVE_UNISTD_H+# include <unistd.h>+#endif++#if HAVE_SYS_STAT_H+# include <sys/stat.h>+#endif++#if HAVE_FCNTL_H+# include <fcntl.h>+#endif++#if HAVE_SIGNAL_H+# include <signal.h>+#endif++#if HAVE_TIME_H+# include <time.h>+#endif++#if HAVE_TERMIOS_H+# include <termios.h>+#endif++#if HAVE_STRING_H+# include <string.h>+#endif++#if HAVE_CTYPE_H+# include <ctype.h>+#endif++#if HAVE_INTTYPES_H+# include <inttypes.h>+#else+# if HAVE_STDINT_H+#  include <stdint.h>+# endif+#endif++#if HAVE_SYS_RESOURCE_H+# include <sys/resource.h>+#endif++#include <stdlib.h>+"; then :++else+  fptools_cv_htype_sup_intptr_t=no+fi+++                if test "$HTYPE_IS_SIGNED" -eq 0+                then+                    fptools_cv_htype_intptr_t="Word$HTYPE_SIZE"+                else+                    fptools_cv_htype_intptr_t="Int$HTYPE_SIZE"+                fi+            fi+        fi++fi++    if test "$fptools_cv_htype_sup_intptr_t" = no+    then++        fptools_cv_htype_intptr_t=NotReallyAType+        { $as_echo "$as_me:${as_lineno-$LINENO}: result: not supported" >&5+$as_echo "not supported" >&6; }++    fi++            if test "$fptools_cv_htype_sup_intptr_t" = yes; then+        { $as_echo "$as_me:${as_lineno-$LINENO}: result: $fptools_cv_htype_intptr_t" >&5+$as_echo "$fptools_cv_htype_intptr_t" >&6; }++cat >>confdefs.h <<_ACEOF+#define HTYPE_INTPTR_T $fptools_cv_htype_intptr_t+_ACEOF++    fi+++++++++++    { $as_echo "$as_me:${as_lineno-$LINENO}: checking Haskell type for uintptr_t" >&5+$as_echo_n "checking Haskell type for uintptr_t... " >&6; }+    if test "${fptools_cv_htype_uintptr_t+set}" = set; then :+  $as_echo_n "(cached) " >&6+else++        fptools_cv_htype_sup_uintptr_t=yes+        if ac_fn_c_compute_int "$LINENO" "((uintptr_t)((int)((uintptr_t)1.4))) == ((uintptr_t)1.4)" "HTYPE_IS_INTEGRAL"        "+#include <stdio.h>+#include <stddef.h>++#if HAVE_SYS_TYPES_H+# include <sys/types.h>+#endif++#if HAVE_UNISTD_H+# include <unistd.h>+#endif++#if HAVE_SYS_STAT_H+# include <sys/stat.h>+#endif++#if HAVE_FCNTL_H+# include <fcntl.h>+#endif++#if HAVE_SIGNAL_H+# include <signal.h>+#endif++#if HAVE_TIME_H+# include <time.h>+#endif++#if HAVE_TERMIOS_H+# include <termios.h>+#endif++#if HAVE_STRING_H+# include <string.h>+#endif++#if HAVE_CTYPE_H+# include <ctype.h>+#endif++#if HAVE_INTTYPES_H+# include <inttypes.h>+#else+# if HAVE_STDINT_H+#  include <stdint.h>+# endif+#endif++#if HAVE_SYS_RESOURCE_H+# include <sys/resource.h>+#endif++#include <stdlib.h>+"; then :++else+  fptools_cv_htype_sup_uintptr_t=no+fi+++        if test "$fptools_cv_htype_sup_uintptr_t" = "yes"+        then+            if test "$HTYPE_IS_INTEGRAL" -eq 0+            then+                if ac_fn_c_compute_int "$LINENO" "sizeof(uintptr_t) == sizeof(float)" "HTYPE_IS_FLOAT"        "+#include <stdio.h>+#include <stddef.h>++#if HAVE_SYS_TYPES_H+# include <sys/types.h>+#endif++#if HAVE_UNISTD_H+# include <unistd.h>+#endif++#if HAVE_SYS_STAT_H+# include <sys/stat.h>+#endif++#if HAVE_FCNTL_H+# include <fcntl.h>+#endif++#if HAVE_SIGNAL_H+# include <signal.h>+#endif++#if HAVE_TIME_H+# include <time.h>+#endif++#if HAVE_TERMIOS_H+# include <termios.h>+#endif++#if HAVE_STRING_H+# include <string.h>+#endif++#if HAVE_CTYPE_H+# include <ctype.h>+#endif++#if HAVE_INTTYPES_H+# include <inttypes.h>+#else+# if HAVE_STDINT_H+#  include <stdint.h>+# endif+#endif++#if HAVE_SYS_RESOURCE_H+# include <sys/resource.h>+#endif++#include <stdlib.h>+"; then :++else+  fptools_cv_htype_sup_uintptr_t=no+fi+++                if ac_fn_c_compute_int "$LINENO" "sizeof(uintptr_t) == sizeof(double)" "HTYPE_IS_DOUBLE"        "+#include <stdio.h>+#include <stddef.h>++#if HAVE_SYS_TYPES_H+# include <sys/types.h>+#endif++#if HAVE_UNISTD_H+# include <unistd.h>+#endif++#if HAVE_SYS_STAT_H+# include <sys/stat.h>+#endif++#if HAVE_FCNTL_H+# include <fcntl.h>+#endif++#if HAVE_SIGNAL_H+# include <signal.h>+#endif++#if HAVE_TIME_H+# include <time.h>+#endif++#if HAVE_TERMIOS_H+# include <termios.h>+#endif++#if HAVE_STRING_H+# include <string.h>+#endif++#if HAVE_CTYPE_H+# include <ctype.h>+#endif++#if HAVE_INTTYPES_H+# include <inttypes.h>+#else+# if HAVE_STDINT_H+#  include <stdint.h>+# endif+#endif++#if HAVE_SYS_RESOURCE_H+# include <sys/resource.h>+#endif++#include <stdlib.h>+"; then :++else+  fptools_cv_htype_sup_uintptr_t=no+fi+++                if ac_fn_c_compute_int "$LINENO" "sizeof(uintptr_t) == sizeof(long double)" "HTYPE_IS_LDOUBLE"        "+#include <stdio.h>+#include <stddef.h>++#if HAVE_SYS_TYPES_H+# include <sys/types.h>+#endif++#if HAVE_UNISTD_H+# include <unistd.h>+#endif++#if HAVE_SYS_STAT_H+# include <sys/stat.h>+#endif++#if HAVE_FCNTL_H+# include <fcntl.h>+#endif++#if HAVE_SIGNAL_H+# include <signal.h>+#endif++#if HAVE_TIME_H+# include <time.h>+#endif++#if HAVE_TERMIOS_H+# include <termios.h>+#endif++#if HAVE_STRING_H+# include <string.h>+#endif++#if HAVE_CTYPE_H+# include <ctype.h>+#endif++#if HAVE_INTTYPES_H+# include <inttypes.h>+#else+# if HAVE_STDINT_H+#  include <stdint.h>+# endif+#endif++#if HAVE_SYS_RESOURCE_H+# include <sys/resource.h>+#endif++#include <stdlib.h>+"; then :++else+  fptools_cv_htype_sup_uintptr_t=no+fi+++                if test "$HTYPE_IS_FLOAT" -eq 1+                then+                    fptools_cv_htype_uintptr_t=Float+                elif test "$HTYPE_IS_DOUBLE" -eq 1+                then+                    fptools_cv_htype_uintptr_t=Double+                elif test "$HTYPE_IS_LDOUBLE" -eq 1+                then+                    fptools_cv_htype_uintptr_t=LDouble+                else+                    fptools_cv_htype_sup_uintptr_t=no+                fi+            else+                if ac_fn_c_compute_int "$LINENO" "((uintptr_t)(-1)) < ((uintptr_t)0)" "HTYPE_IS_SIGNED"        "+#include <stdio.h>+#include <stddef.h>++#if HAVE_SYS_TYPES_H+# include <sys/types.h>+#endif++#if HAVE_UNISTD_H+# include <unistd.h>+#endif++#if HAVE_SYS_STAT_H+# include <sys/stat.h>+#endif++#if HAVE_FCNTL_H+# include <fcntl.h>+#endif++#if HAVE_SIGNAL_H+# include <signal.h>+#endif++#if HAVE_TIME_H+# include <time.h>+#endif++#if HAVE_TERMIOS_H+# include <termios.h>+#endif++#if HAVE_STRING_H+# include <string.h>+#endif++#if HAVE_CTYPE_H+# include <ctype.h>+#endif++#if HAVE_INTTYPES_H+# include <inttypes.h>+#else+# if HAVE_STDINT_H+#  include <stdint.h>+# endif+#endif++#if HAVE_SYS_RESOURCE_H+# include <sys/resource.h>+#endif++#include <stdlib.h>+"; then :++else+  fptools_cv_htype_sup_uintptr_t=no+fi+++                if ac_fn_c_compute_int "$LINENO" "sizeof(uintptr_t) * 8" "HTYPE_SIZE"        "+#include <stdio.h>+#include <stddef.h>++#if HAVE_SYS_TYPES_H+# include <sys/types.h>+#endif++#if HAVE_UNISTD_H+# include <unistd.h>+#endif++#if HAVE_SYS_STAT_H+# include <sys/stat.h>+#endif++#if HAVE_FCNTL_H+# include <fcntl.h>+#endif++#if HAVE_SIGNAL_H+# include <signal.h>+#endif++#if HAVE_TIME_H+# include <time.h>+#endif++#if HAVE_TERMIOS_H+# include <termios.h>+#endif++#if HAVE_STRING_H+# include <string.h>+#endif++#if HAVE_CTYPE_H+# include <ctype.h>+#endif++#if HAVE_INTTYPES_H+# include <inttypes.h>+#else+# if HAVE_STDINT_H+#  include <stdint.h>+# endif+#endif++#if HAVE_SYS_RESOURCE_H+# include <sys/resource.h>+#endif++#include <stdlib.h>+"; then :++else+  fptools_cv_htype_sup_uintptr_t=no+fi+++                if test "$HTYPE_IS_SIGNED" -eq 0+                then+                    fptools_cv_htype_uintptr_t="Word$HTYPE_SIZE"+                else+                    fptools_cv_htype_uintptr_t="Int$HTYPE_SIZE"+                fi+            fi+        fi++fi++    if test "$fptools_cv_htype_sup_uintptr_t" = no+    then++        fptools_cv_htype_uintptr_t=NotReallyAType+        { $as_echo "$as_me:${as_lineno-$LINENO}: result: not supported" >&5+$as_echo "not supported" >&6; }++    fi++            if test "$fptools_cv_htype_sup_uintptr_t" = yes; then+        { $as_echo "$as_me:${as_lineno-$LINENO}: result: $fptools_cv_htype_uintptr_t" >&5+$as_echo "$fptools_cv_htype_uintptr_t" >&6; }++cat >>confdefs.h <<_ACEOF+#define HTYPE_UINTPTR_T $fptools_cv_htype_uintptr_t+_ACEOF++    fi+++++++++++    { $as_echo "$as_me:${as_lineno-$LINENO}: checking Haskell type for intmax_t" >&5+$as_echo_n "checking Haskell type for intmax_t... " >&6; }+    if test "${fptools_cv_htype_intmax_t+set}" = set; then :+  $as_echo_n "(cached) " >&6+else++        fptools_cv_htype_sup_intmax_t=yes+        if ac_fn_c_compute_int "$LINENO" "((intmax_t)((int)((intmax_t)1.4))) == ((intmax_t)1.4)" "HTYPE_IS_INTEGRAL"        "+#include <stdio.h>+#include <stddef.h>++#if HAVE_SYS_TYPES_H+# include <sys/types.h>+#endif++#if HAVE_UNISTD_H+# include <unistd.h>+#endif++#if HAVE_SYS_STAT_H+# include <sys/stat.h>+#endif++#if HAVE_FCNTL_H+# include <fcntl.h>+#endif++#if HAVE_SIGNAL_H+# include <signal.h>+#endif++#if HAVE_TIME_H+# include <time.h>+#endif++#if HAVE_TERMIOS_H+# include <termios.h>+#endif++#if HAVE_STRING_H+# include <string.h>+#endif++#if HAVE_CTYPE_H+# include <ctype.h>+#endif++#if HAVE_INTTYPES_H+# include <inttypes.h>+#else+# if HAVE_STDINT_H+#  include <stdint.h>+# endif+#endif++#if HAVE_SYS_RESOURCE_H+# include <sys/resource.h>+#endif++#include <stdlib.h>+"; then :++else+  fptools_cv_htype_sup_intmax_t=no+fi+++        if test "$fptools_cv_htype_sup_intmax_t" = "yes"+        then+            if test "$HTYPE_IS_INTEGRAL" -eq 0+            then+                if ac_fn_c_compute_int "$LINENO" "sizeof(intmax_t) == sizeof(float)" "HTYPE_IS_FLOAT"        "+#include <stdio.h>+#include <stddef.h>++#if HAVE_SYS_TYPES_H+# include <sys/types.h>+#endif++#if HAVE_UNISTD_H+# include <unistd.h>+#endif++#if HAVE_SYS_STAT_H+# include <sys/stat.h>+#endif++#if HAVE_FCNTL_H+# include <fcntl.h>+#endif++#if HAVE_SIGNAL_H+# include <signal.h>+#endif++#if HAVE_TIME_H+# include <time.h>+#endif++#if HAVE_TERMIOS_H+# include <termios.h>+#endif++#if HAVE_STRING_H+# include <string.h>+#endif++#if HAVE_CTYPE_H+# include <ctype.h>+#endif++#if HAVE_INTTYPES_H+# include <inttypes.h>+#else+# if HAVE_STDINT_H+#  include <stdint.h>+# endif+#endif++#if HAVE_SYS_RESOURCE_H+# include <sys/resource.h>+#endif++#include <stdlib.h>+"; then :++else+  fptools_cv_htype_sup_intmax_t=no+fi+++                if ac_fn_c_compute_int "$LINENO" "sizeof(intmax_t) == sizeof(double)" "HTYPE_IS_DOUBLE"        "+#include <stdio.h>+#include <stddef.h>++#if HAVE_SYS_TYPES_H+# include <sys/types.h>+#endif++#if HAVE_UNISTD_H+# include <unistd.h>+#endif++#if HAVE_SYS_STAT_H+# include <sys/stat.h>+#endif++#if HAVE_FCNTL_H+# include <fcntl.h>+#endif++#if HAVE_SIGNAL_H+# include <signal.h>+#endif++#if HAVE_TIME_H+# include <time.h>+#endif++#if HAVE_TERMIOS_H+# include <termios.h>+#endif++#if HAVE_STRING_H+# include <string.h>+#endif++#if HAVE_CTYPE_H+# include <ctype.h>+#endif++#if HAVE_INTTYPES_H+# include <inttypes.h>+#else+# if HAVE_STDINT_H+#  include <stdint.h>+# endif+#endif++#if HAVE_SYS_RESOURCE_H+# include <sys/resource.h>+#endif++#include <stdlib.h>+"; then :++else+  fptools_cv_htype_sup_intmax_t=no+fi+++                if ac_fn_c_compute_int "$LINENO" "sizeof(intmax_t) == sizeof(long double)" "HTYPE_IS_LDOUBLE"        "+#include <stdio.h>+#include <stddef.h>++#if HAVE_SYS_TYPES_H+# include <sys/types.h>+#endif++#if HAVE_UNISTD_H+# include <unistd.h>+#endif++#if HAVE_SYS_STAT_H+# include <sys/stat.h>+#endif++#if HAVE_FCNTL_H+# include <fcntl.h>+#endif++#if HAVE_SIGNAL_H+# include <signal.h>+#endif++#if HAVE_TIME_H+# include <time.h>+#endif++#if HAVE_TERMIOS_H+# include <termios.h>+#endif++#if HAVE_STRING_H+# include <string.h>+#endif++#if HAVE_CTYPE_H+# include <ctype.h>+#endif++#if HAVE_INTTYPES_H+# include <inttypes.h>+#else+# if HAVE_STDINT_H+#  include <stdint.h>+# endif+#endif++#if HAVE_SYS_RESOURCE_H+# include <sys/resource.h>+#endif++#include <stdlib.h>+"; then :++else+  fptools_cv_htype_sup_intmax_t=no+fi+++                if test "$HTYPE_IS_FLOAT" -eq 1+                then+                    fptools_cv_htype_intmax_t=Float+                elif test "$HTYPE_IS_DOUBLE" -eq 1+                then+                    fptools_cv_htype_intmax_t=Double+                elif test "$HTYPE_IS_LDOUBLE" -eq 1+                then+                    fptools_cv_htype_intmax_t=LDouble+                else+                    fptools_cv_htype_sup_intmax_t=no+                fi+            else+                if ac_fn_c_compute_int "$LINENO" "((intmax_t)(-1)) < ((intmax_t)0)" "HTYPE_IS_SIGNED"        "+#include <stdio.h>+#include <stddef.h>++#if HAVE_SYS_TYPES_H+# include <sys/types.h>+#endif++#if HAVE_UNISTD_H+# include <unistd.h>+#endif++#if HAVE_SYS_STAT_H+# include <sys/stat.h>+#endif++#if HAVE_FCNTL_H+# include <fcntl.h>+#endif++#if HAVE_SIGNAL_H+# include <signal.h>+#endif++#if HAVE_TIME_H+# include <time.h>+#endif++#if HAVE_TERMIOS_H+# include <termios.h>+#endif++#if HAVE_STRING_H+# include <string.h>+#endif++#if HAVE_CTYPE_H+# include <ctype.h>+#endif++#if HAVE_INTTYPES_H+# include <inttypes.h>+#else+# if HAVE_STDINT_H+#  include <stdint.h>+# endif+#endif++#if HAVE_SYS_RESOURCE_H+# include <sys/resource.h>+#endif++#include <stdlib.h>+"; then :++else+  fptools_cv_htype_sup_intmax_t=no+fi+++                if ac_fn_c_compute_int "$LINENO" "sizeof(intmax_t) * 8" "HTYPE_SIZE"        "+#include <stdio.h>+#include <stddef.h>++#if HAVE_SYS_TYPES_H+# include <sys/types.h>+#endif++#if HAVE_UNISTD_H+# include <unistd.h>+#endif++#if HAVE_SYS_STAT_H+# include <sys/stat.h>+#endif++#if HAVE_FCNTL_H+# include <fcntl.h>+#endif++#if HAVE_SIGNAL_H+# include <signal.h>+#endif++#if HAVE_TIME_H+# include <time.h>+#endif++#if HAVE_TERMIOS_H+# include <termios.h>+#endif++#if HAVE_STRING_H+# include <string.h>+#endif++#if HAVE_CTYPE_H+# include <ctype.h>+#endif++#if HAVE_INTTYPES_H+# include <inttypes.h>+#else+# if HAVE_STDINT_H+#  include <stdint.h>+# endif+#endif++#if HAVE_SYS_RESOURCE_H+# include <sys/resource.h>+#endif++#include <stdlib.h>+"; then :++else+  fptools_cv_htype_sup_intmax_t=no+fi+++                if test "$HTYPE_IS_SIGNED" -eq 0+                then+                    fptools_cv_htype_intmax_t="Word$HTYPE_SIZE"+                else+                    fptools_cv_htype_intmax_t="Int$HTYPE_SIZE"+                fi+            fi+        fi++fi++    if test "$fptools_cv_htype_sup_intmax_t" = no+    then++        fptools_cv_htype_intmax_t=NotReallyAType+        { $as_echo "$as_me:${as_lineno-$LINENO}: result: not supported" >&5+$as_echo "not supported" >&6; }++    fi++            if test "$fptools_cv_htype_sup_intmax_t" = yes; then+        { $as_echo "$as_me:${as_lineno-$LINENO}: result: $fptools_cv_htype_intmax_t" >&5+$as_echo "$fptools_cv_htype_intmax_t" >&6; }++cat >>confdefs.h <<_ACEOF+#define HTYPE_INTMAX_T $fptools_cv_htype_intmax_t+_ACEOF++    fi+++++++++++    { $as_echo "$as_me:${as_lineno-$LINENO}: checking Haskell type for uintmax_t" >&5+$as_echo_n "checking Haskell type for uintmax_t... " >&6; }+    if test "${fptools_cv_htype_uintmax_t+set}" = set; then :+  $as_echo_n "(cached) " >&6+else++        fptools_cv_htype_sup_uintmax_t=yes+        if ac_fn_c_compute_int "$LINENO" "((uintmax_t)((int)((uintmax_t)1.4))) == ((uintmax_t)1.4)" "HTYPE_IS_INTEGRAL"        "+#include <stdio.h>+#include <stddef.h>++#if HAVE_SYS_TYPES_H+# include <sys/types.h>+#endif++#if HAVE_UNISTD_H+# include <unistd.h>+#endif++#if HAVE_SYS_STAT_H+# include <sys/stat.h>+#endif++#if HAVE_FCNTL_H+# include <fcntl.h>+#endif++#if HAVE_SIGNAL_H+# include <signal.h>+#endif++#if HAVE_TIME_H+# include <time.h>+#endif++#if HAVE_TERMIOS_H+# include <termios.h>+#endif++#if HAVE_STRING_H+# include <string.h>+#endif++#if HAVE_CTYPE_H+# include <ctype.h>+#endif++#if HAVE_INTTYPES_H+# include <inttypes.h>+#else+# if HAVE_STDINT_H+#  include <stdint.h>+# endif+#endif++#if HAVE_SYS_RESOURCE_H+# include <sys/resource.h>+#endif++#include <stdlib.h>+"; then :++else+  fptools_cv_htype_sup_uintmax_t=no+fi+++        if test "$fptools_cv_htype_sup_uintmax_t" = "yes"+        then+            if test "$HTYPE_IS_INTEGRAL" -eq 0+            then+                if ac_fn_c_compute_int "$LINENO" "sizeof(uintmax_t) == sizeof(float)" "HTYPE_IS_FLOAT"        "+#include <stdio.h>+#include <stddef.h>++#if HAVE_SYS_TYPES_H+# include <sys/types.h>+#endif++#if HAVE_UNISTD_H+# include <unistd.h>+#endif++#if HAVE_SYS_STAT_H+# include <sys/stat.h>+#endif++#if HAVE_FCNTL_H+# include <fcntl.h>+#endif++#if HAVE_SIGNAL_H+# include <signal.h>+#endif++#if HAVE_TIME_H+# include <time.h>+#endif++#if HAVE_TERMIOS_H+# include <termios.h>+#endif++#if HAVE_STRING_H+# include <string.h>+#endif++#if HAVE_CTYPE_H+# include <ctype.h>+#endif++#if HAVE_INTTYPES_H+# include <inttypes.h>+#else+# if HAVE_STDINT_H+#  include <stdint.h>+# endif+#endif++#if HAVE_SYS_RESOURCE_H+# include <sys/resource.h>+#endif++#include <stdlib.h>+"; then :++else+  fptools_cv_htype_sup_uintmax_t=no+fi+++                if ac_fn_c_compute_int "$LINENO" "sizeof(uintmax_t) == sizeof(double)" "HTYPE_IS_DOUBLE"        "+#include <stdio.h>+#include <stddef.h>++#if HAVE_SYS_TYPES_H+# include <sys/types.h>+#endif++#if HAVE_UNISTD_H+# include <unistd.h>+#endif++#if HAVE_SYS_STAT_H+# include <sys/stat.h>+#endif++#if HAVE_FCNTL_H+# include <fcntl.h>+#endif++#if HAVE_SIGNAL_H+# include <signal.h>+#endif++#if HAVE_TIME_H+# include <time.h>+#endif++#if HAVE_TERMIOS_H+# include <termios.h>+#endif++#if HAVE_STRING_H+# include <string.h>+#endif++#if HAVE_CTYPE_H+# include <ctype.h>+#endif++#if HAVE_INTTYPES_H+# include <inttypes.h>+#else+# if HAVE_STDINT_H+#  include <stdint.h>+# endif+#endif++#if HAVE_SYS_RESOURCE_H+# include <sys/resource.h>+#endif++#include <stdlib.h>+"; then :++else+  fptools_cv_htype_sup_uintmax_t=no+fi+++                if ac_fn_c_compute_int "$LINENO" "sizeof(uintmax_t) == sizeof(long double)" "HTYPE_IS_LDOUBLE"        "+#include <stdio.h>+#include <stddef.h>++#if HAVE_SYS_TYPES_H+# include <sys/types.h>+#endif++#if HAVE_UNISTD_H+# include <unistd.h>+#endif++#if HAVE_SYS_STAT_H+# include <sys/stat.h>+#endif++#if HAVE_FCNTL_H+# include <fcntl.h>+#endif++#if HAVE_SIGNAL_H+# include <signal.h>+#endif++#if HAVE_TIME_H+# include <time.h>+#endif++#if HAVE_TERMIOS_H+# include <termios.h>+#endif++#if HAVE_STRING_H+# include <string.h>+#endif++#if HAVE_CTYPE_H+# include <ctype.h>+#endif++#if HAVE_INTTYPES_H+# include <inttypes.h>+#else+# if HAVE_STDINT_H+#  include <stdint.h>+# endif+#endif++#if HAVE_SYS_RESOURCE_H+# include <sys/resource.h>+#endif++#include <stdlib.h>+"; then :++else+  fptools_cv_htype_sup_uintmax_t=no+fi+++                if test "$HTYPE_IS_FLOAT" -eq 1+                then+                    fptools_cv_htype_uintmax_t=Float+                elif test "$HTYPE_IS_DOUBLE" -eq 1+                then+                    fptools_cv_htype_uintmax_t=Double+                elif test "$HTYPE_IS_LDOUBLE" -eq 1+                then+                    fptools_cv_htype_uintmax_t=LDouble+                else+                    fptools_cv_htype_sup_uintmax_t=no+                fi+            else+                if ac_fn_c_compute_int "$LINENO" "((uintmax_t)(-1)) < ((uintmax_t)0)" "HTYPE_IS_SIGNED"        "+#include <stdio.h>+#include <stddef.h>++#if HAVE_SYS_TYPES_H+# include <sys/types.h>+#endif++#if HAVE_UNISTD_H+# include <unistd.h>+#endif++#if HAVE_SYS_STAT_H+# include <sys/stat.h>+#endif++#if HAVE_FCNTL_H+# include <fcntl.h>+#endif++#if HAVE_SIGNAL_H+# include <signal.h>+#endif++#if HAVE_TIME_H+# include <time.h>+#endif++#if HAVE_TERMIOS_H+# include <termios.h>+#endif++#if HAVE_STRING_H+# include <string.h>+#endif++#if HAVE_CTYPE_H+# include <ctype.h>+#endif++#if HAVE_INTTYPES_H+# include <inttypes.h>+#else+# if HAVE_STDINT_H+#  include <stdint.h>+# endif+#endif++#if HAVE_SYS_RESOURCE_H+# include <sys/resource.h>+#endif++#include <stdlib.h>+"; then :++else+  fptools_cv_htype_sup_uintmax_t=no+fi+++                if ac_fn_c_compute_int "$LINENO" "sizeof(uintmax_t) * 8" "HTYPE_SIZE"        "+#include <stdio.h>+#include <stddef.h>++#if HAVE_SYS_TYPES_H+# include <sys/types.h>+#endif++#if HAVE_UNISTD_H+# include <unistd.h>+#endif++#if HAVE_SYS_STAT_H+# include <sys/stat.h>+#endif++#if HAVE_FCNTL_H+# include <fcntl.h>+#endif++#if HAVE_SIGNAL_H+# include <signal.h>+#endif++#if HAVE_TIME_H+# include <time.h>+#endif++#if HAVE_TERMIOS_H+# include <termios.h>+#endif++#if HAVE_STRING_H+# include <string.h>+#endif++#if HAVE_CTYPE_H+# include <ctype.h>+#endif++#if HAVE_INTTYPES_H+# include <inttypes.h>+#else+# if HAVE_STDINT_H+#  include <stdint.h>+# endif+#endif++#if HAVE_SYS_RESOURCE_H+# include <sys/resource.h>+#endif++#include <stdlib.h>+"; then :++else+  fptools_cv_htype_sup_uintmax_t=no+fi+++                if test "$HTYPE_IS_SIGNED" -eq 0+                then+                    fptools_cv_htype_uintmax_t="Word$HTYPE_SIZE"+                else+                    fptools_cv_htype_uintmax_t="Int$HTYPE_SIZE"+                fi+            fi+        fi++fi++    if test "$fptools_cv_htype_sup_uintmax_t" = no+    then++        fptools_cv_htype_uintmax_t=NotReallyAType+        { $as_echo "$as_me:${as_lineno-$LINENO}: result: not supported" >&5+$as_echo "not supported" >&6; }++    fi++            if test "$fptools_cv_htype_sup_uintmax_t" = yes; then+        { $as_echo "$as_me:${as_lineno-$LINENO}: result: $fptools_cv_htype_uintmax_t" >&5+$as_echo "$fptools_cv_htype_uintmax_t" >&6; }++cat >>confdefs.h <<_ACEOF+#define HTYPE_UINTMAX_T $fptools_cv_htype_uintmax_t+_ACEOF++    fi++++# test errno values+for fp_const_name in E2BIG EACCES EADDRINUSE EADDRNOTAVAIL EADV EAFNOSUPPORT EAGAIN EALREADY EBADF EBADMSG EBADRPC EBUSY ECHILD ECOMM ECONNABORTED ECONNREFUSED ECONNRESET EDEADLK EDESTADDRREQ EDIRTY EDOM EDQUOT EEXIST EFAULT EFBIG EFTYPE EHOSTDOWN EHOSTUNREACH EIDRM EILSEQ EINPROGRESS EINTR EINVAL EIO EISCONN EISDIR ELOOP EMFILE EMLINK EMSGSIZE EMULTIHOP ENAMETOOLONG ENETDOWN ENETRESET ENETUNREACH ENFILE ENOBUFS ENODATA ENODEV ENOENT ENOEXEC ENOLCK ENOLINK ENOMEM ENOMSG ENONET ENOPROTOOPT ENOSPC ENOSR ENOSTR ENOSYS ENOTBLK ENOTCONN ENOTDIR ENOTEMPTY ENOTSOCK ENOTTY ENXIO EOPNOTSUPP EPERM EPFNOSUPPORT EPIPE EPROCLIM EPROCUNAVAIL EPROGMISMATCH EPROGUNAVAIL EPROTO EPROTONOSUPPORT EPROTOTYPE ERANGE EREMCHG EREMOTE EROFS ERPCMISMATCH ERREMOTE ESHUTDOWN ESOCKTNOSUPPORT ESPIPE ESRCH ESRMNT ESTALE ETIME ETIMEDOUT ETOOMANYREFS ETXTBSY EUSERS EWOULDBLOCK EXDEV ENOCIGAR+do+as_fp_Cache=`$as_echo "fp_cv_const_$fp_const_name" | $as_tr_sh`+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking value of $fp_const_name" >&5+$as_echo_n "checking value of $fp_const_name... " >&6; }+if eval "test \"\${$as_fp_Cache+set}\"" = set; then :+  $as_echo_n "(cached) " >&6+else+  if ac_fn_c_compute_int "$LINENO" "$fp_const_name" "fp_check_const_result"        "#include <stdio.h>+#include <errno.h>+"; then :++else+  fp_check_const_result='-1'+fi+++eval "$as_fp_Cache=\$fp_check_const_result"+fi+eval ac_res=\$$as_fp_Cache+	       { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5+$as_echo "$ac_res" >&6; }+cat >>confdefs.h <<_ACEOF+#define `$as_echo "CONST_$fp_const_name" | $as_tr_cpp` `eval 'as_val=${'$as_fp_Cache'};$as_echo "$as_val"'`+_ACEOF++done+++# we need SIGINT in TopHandler.lhs+for fp_const_name in SIGINT+do+as_fp_Cache=`$as_echo "fp_cv_const_$fp_const_name" | $as_tr_sh`+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking value of $fp_const_name" >&5+$as_echo_n "checking value of $fp_const_name... " >&6; }+if eval "test \"\${$as_fp_Cache+set}\"" = set; then :+  $as_echo_n "(cached) " >&6+else+  if ac_fn_c_compute_int "$LINENO" "$fp_const_name" "fp_check_const_result"        "+#if HAVE_SIGNAL_H+#include <signal.h>+#endif+"; then :++else+  fp_check_const_result='-1'+fi+++eval "$as_fp_Cache=\$fp_check_const_result"+fi+eval ac_res=\$$as_fp_Cache+	       { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5+$as_echo "$ac_res" >&6; }+cat >>confdefs.h <<_ACEOF+#define `$as_echo "CONST_$fp_const_name" | $as_tr_cpp` `eval 'as_val=${'$as_fp_Cache'};$as_echo "$as_val"'`+_ACEOF++done+++{ $as_echo "$as_me:${as_lineno-$LINENO}: checking value of O_BINARY" >&5+$as_echo_n "checking value of O_BINARY... " >&6; }+if test "${fp_cv_const_O_BINARY+set}" = set; then :+  $as_echo_n "(cached) " >&6+else+  if ac_fn_c_compute_int "$LINENO" "O_BINARY" "fp_check_const_result"        "#include <fcntl.h>+"; then :++else+  fp_check_const_result=0+fi+++fp_cv_const_O_BINARY=$fp_check_const_result+fi+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $fp_cv_const_O_BINARY" >&5+$as_echo "$fp_cv_const_O_BINARY" >&6; }+cat >>confdefs.h <<_ACEOF+#define CONST_O_BINARY $fp_cv_const_O_BINARY+_ACEOF+++# 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.+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for library containing iconv" >&5+$as_echo_n "checking for library containing iconv... " >&6; }+if test "${ac_cv_search_iconv+set}" = set; then :+  $as_echo_n "(cached) " >&6+else+  ac_func_search_save_LIBS=$LIBS+cat confdefs.h - <<_ACEOF >conftest.$ac_ext+/* end confdefs.h.  */++#include <stddef.h>+#include <iconv.h>++int+main ()+{+iconv_t cd;+                      cd = iconv_open("", "");+                      iconv(cd,NULL,NULL,NULL,NULL);+                      iconv_close(cd);+  ;+  return 0;+}+_ACEOF+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+  if ac_fn_c_try_link "$LINENO"; then :+  ac_cv_search_iconv=$ac_res+fi+rm -f core conftest.err conftest.$ac_objext \+    conftest$ac_exeext+  if test "${ac_cv_search_iconv+set}" = set; then :+  break+fi+done+if test "${ac_cv_search_iconv+set}" = set; then :++else+  ac_cv_search_iconv=no+fi+rm conftest.$ac_ext+LIBS=$ac_func_search_save_LIBS+fi+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_search_iconv" >&5+$as_echo "$ac_cv_search_iconv" >&6; }+ac_res=$ac_cv_search_iconv+if test "$ac_res" != no; then :+  test "$ac_res" = "none required" || LIBS="$ac_res $LIBS"+  EXTRA_LIBS="$EXTRA_LIBS $ac_lib"+else+  if test "$WINDOWS" = "NO"+                      then+                          as_fn_error $? "iconv is required on non-Windows platforms" "$LINENO" 5+                      fi+fi++# If possible, we use libcharset instead of nl_langinfo(CODESET) to+# determine the current locale's character encoding.+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for library containing locale_charset" >&5+$as_echo_n "checking for library containing locale_charset... " >&6; }+if test "${ac_cv_search_locale_charset+set}" = set; then :+  $as_echo_n "(cached) " >&6+else+  ac_func_search_save_LIBS=$LIBS+cat confdefs.h - <<_ACEOF >conftest.$ac_ext+/* end confdefs.h.  */+#include <libcharset.h>+int+main ()+{+const char* charset = locale_charset();+  ;+  return 0;+}+_ACEOF+for ac_lib in '' charset; 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+  if ac_fn_c_try_link "$LINENO"; then :+  ac_cv_search_locale_charset=$ac_res+fi+rm -f core conftest.err conftest.$ac_objext \+    conftest$ac_exeext+  if test "${ac_cv_search_locale_charset+set}" = set; then :+  break+fi+done+if test "${ac_cv_search_locale_charset+set}" = set; then :++else+  ac_cv_search_locale_charset=no+fi+rm conftest.$ac_ext+LIBS=$ac_func_search_save_LIBS+fi+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_search_locale_charset" >&5+$as_echo "$ac_cv_search_locale_charset" >&6; }+ac_res=$ac_cv_search_locale_charset+if test "$ac_res" != no; then :+  test "$ac_res" = "none required" || LIBS="$ac_res $LIBS"++$as_echo "#define HAVE_LIBCHARSET 1" >>confdefs.h++     EXTRA_LIBS="$EXTRA_LIBS $ac_lib"+fi++# Hack - md5.h needs HsFFI.h.  Is there a better way to do this?+CFLAGS="-I../../includes $CFLAGS"+# The cast to long int works around a bug in the HP C Compiler+# version HP92453-01 B.11.11.23709.GP, which incorrectly rejects+# declarations like `int a3[[(sizeof (unsigned char)) >= 0]];'.+# This bug is HP SR number 8606223364.+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking size of struct MD5Context" >&5+$as_echo_n "checking size of struct MD5Context... " >&6; }+if test "${ac_cv_sizeof_struct_MD5Context+set}" = set; then :+  $as_echo_n "(cached) " >&6+else+  if ac_fn_c_compute_int "$LINENO" "(long int) (sizeof (struct MD5Context))" "ac_cv_sizeof_struct_MD5Context"        "#include \"include/md5.h\"+"; then :++else+  if test "$ac_cv_type_struct_MD5Context" = yes; then+     { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5+$as_echo "$as_me: error: in \`$ac_pwd':" >&2;}+as_fn_error 77 "cannot compute sizeof (struct MD5Context)+See \`config.log' for more details" "$LINENO" 5 ; }+   else+     ac_cv_sizeof_struct_MD5Context=0+   fi+fi++fi+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_sizeof_struct_MD5Context" >&5+$as_echo "$ac_cv_sizeof_struct_MD5Context" >&6; }++++cat >>confdefs.h <<_ACEOF+#define SIZEOF_STRUCT_MD5CONTEXT $ac_cv_sizeof_struct_MD5Context+_ACEOF+
configure.ac view
@@ -10,6 +10,13 @@             [CC=$withval]) AC_PROG_CC() +case `uname -s` in+    MINGW*|CYGWIN*)+        WINDOWS=YES;;+    *)+        WINDOWS=NO;;+esac+ # do we have long longs? AC_CHECK_TYPES([long long]) @@ -32,7 +39,7 @@ AC_CHECK_FUNCS([getclock getrusage times]) AC_CHECK_FUNCS([_chsize ftruncate]) -AC_CHECK_FUNCS([epoll_create1 epoll_ctl eventfd kevent kevent64 kqueue poll])+AC_CHECK_FUNCS([epoll_ctl eventfd kevent kevent64 kqueue poll])  # event-related fun @@ -86,11 +93,19 @@ FPTOOLS_CHECK_HTYPE(ptrdiff_t) FPTOOLS_CHECK_HTYPE(size_t) FPTOOLS_CHECK_HTYPE(wchar_t)-# Int32 is a HACK for non-ISO C compilers-FPTOOLS_CHECK_HTYPE(sig_atomic_t, Int32)+FPTOOLS_CHECK_HTYPE(sig_atomic_t) FPTOOLS_CHECK_HTYPE(clock_t) FPTOOLS_CHECK_HTYPE(time_t)-FPTOOLS_CHECK_HTYPE(dev_t, Word32)+FPTOOLS_CHECK_HTYPE(useconds_t)+FPTOOLS_CHECK_HTYPE_ELSE(suseconds_t,+                         [if test "$WINDOWS" = "YES"+                          then+                              AC_CV_NAME=Int32+                              AC_CV_NAME_supported=yes+                          else+                              AC_MSG_ERROR([type not found])+                          fi])+FPTOOLS_CHECK_HTYPE(dev_t) FPTOOLS_CHECK_HTYPE(ino_t) FPTOOLS_CHECK_HTYPE(mode_t) FPTOOLS_CHECK_HTYPE(off_t)@@ -103,20 +118,11 @@ FPTOOLS_CHECK_HTYPE(nlink_t) FPTOOLS_CHECK_HTYPE(ssize_t) FPTOOLS_CHECK_HTYPE(rlim_t)-FPTOOLS_CHECK_HTYPE(wint_t)  FPTOOLS_CHECK_HTYPE(intptr_t) FPTOOLS_CHECK_HTYPE(uintptr_t)-# Workaround for OSes that don't have intmax_t and uintmax_t, e.g. OpenBSD.-if test "$ac_cv_type_long_long" = yes; then-  fptools_cv_default_htype_intmax=$fptools_cv_htype_long_long-  fptools_cv_default_htype_uintmax=$fptools_cv_htype_unsigned_long_long-else-  fptools_cv_default_htype_intmax=$fptools_cv_htype_long-  fptools_cv_default_htype_uintmax=$fptools_cv_htype_unsigned_long-fi-FPTOOLS_CHECK_HTYPE(intmax_t, $fptools_cv_default_htype_intmax)-FPTOOLS_CHECK_HTYPE(uintmax_t, $fptools_cv_default_htype_uintmax)+FPTOOLS_CHECK_HTYPE(intmax_t)+FPTOOLS_CHECK_HTYPE(uintmax_t)  # test errno values FP_CHECK_CONSTS([E2BIG EACCES EADDRINUSE EADDRNOTAVAIL EADV EAFNOSUPPORT EAGAIN EALREADY EBADF EBADMSG EBADRPC EBUSY ECHILD ECOMM ECONNABORTED ECONNREFUSED ECONNRESET EDEADLK EDESTADDRREQ EDIRTY EDOM EDQUOT EEXIST EFAULT EFBIG EFTYPE EHOSTDOWN EHOSTUNREACH EIDRM EILSEQ EINPROGRESS EINTR EINVAL EIO EISCONN EISDIR ELOOP EMFILE EMLINK EMSGSIZE EMULTIHOP ENAMETOOLONG ENETDOWN ENETRESET ENETUNREACH ENFILE ENOBUFS ENODATA ENODEV ENOENT ENOEXEC ENOLCK ENOLINK ENOMEM ENOMSG ENONET ENOPROTOOPT ENOSPC ENOSR ENOSTR ENOSYS ENOTBLK ENOTCONN ENOTDIR ENOTEMPTY ENOTSOCK ENOTTY ENXIO EOPNOTSUPP EPERM EPFNOSUPPORT EPIPE EPROCLIM EPROCUNAVAIL EPROGMISMATCH EPROGUNAVAIL EPROTO EPROTONOSUPPORT EPROTOTYPE ERANGE EREMCHG EREMOTE EROFS ERPCMISMATCH ERREMOTE ESHUTDOWN ESOCKTNOSUPPORT ESPIPE ESRCH ESRMNT ESTALE ETIME ETIMEDOUT ETOOMANYREFS ETXTBSY EUSERS EWOULDBLOCK EXDEV ENOCIGAR], [#include <stdio.h>@@ -146,11 +152,10 @@                       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])+                     [if test "$WINDOWS" = "NO"+                      then+                          AC_MSG_ERROR([iconv is required on non-Windows platforms])+                      fi])  # If possible, we use libcharset instead of nl_langinfo(CODESET) to # determine the current locale's character encoding.@@ -162,6 +167,9 @@     [AC_DEFINE([HAVE_LIBCHARSET], [1], [Define to 1 if you have libcharset.])      EXTRA_LIBS="$EXTRA_LIBS $ac_lib"]) +# Hack - md5.h needs HsFFI.h.  Is there a better way to do this?+CFLAGS="-I../../includes $CFLAGS"+AC_CHECK_SIZEOF([struct MD5Context], ,[#include "include/md5.h"])  AC_SUBST(EXTRA_LIBS) AC_CONFIG_FILES([base.buildinfo])
include/EventConfig.h view
@@ -5,7 +5,7 @@ #define HAVE_EPOLL 1  /* Define to 1 if you have the `epoll_create1' function. */-#define HAVE_EPOLL_CREATE1 1+/* #undef HAVE_EPOLL_CREATE1 */  /* Define to 1 if you have the `epoll_ctl' function. */ #define HAVE_EPOLL_CTL 1
include/HsBase.h view
@@ -652,10 +652,17 @@ } #endif /* !defined(__MINGW32__) */ +#if darwin_HOST_OS+// You should not access _environ directly on Darwin in a bundle/shared library.+// See #2458 and http://developer.apple.com/library/mac/#documentation/Darwin/Reference/ManPages/man7/environ.7.html+#include <crt_externs.h>+INLINE char **__hscore_environ() { return *(_NSGetEnviron()); }+#else /* ToDo: write a feature test that doesn't assume 'environ' to  *    be in scope at link-time. */ extern char** environ; INLINE char **__hscore_environ() { return environ; }+#endif  /* lossless conversions between pointers and integral types */ INLINE void *    __hscore_from_uintptr(uintptr_t n) { return (void *)n; }
include/HsBaseConfig.h view
@@ -310,9 +310,6 @@ /* Define if you have epoll support. */ #define HAVE_EPOLL 1 -/* Define to 1 if you have the `epoll_create1' function. */-#define HAVE_EPOLL_CREATE1 1- /* Define to 1 if you have the `epoll_ctl' function. */ #define HAVE_EPOLL_CTL 1 @@ -532,6 +529,9 @@ /* Define to Haskell type for ssize_t */ #define HTYPE_SSIZE_T Int64 +/* Define to Haskell type for suseconds_t */+#define HTYPE_SUSECONDS_T Int64+ /* Define to Haskell type for tcflag_t */ #define HTYPE_TCFLAG_T Word32 @@ -562,12 +562,12 @@ /* Define to Haskell type for unsigned short */ #define HTYPE_UNSIGNED_SHORT Word16 +/* Define to Haskell type for useconds_t */+#define HTYPE_USECONDS_T Word32+ /* Define to Haskell type for wchar_t */ #define HTYPE_WCHAR_T Int32 -/* Define to Haskell type for wint_t */-/* #undef HTYPE_WINT_T */- /* Define to the address where bug reports for this package should be sent. */ #define PACKAGE_BUGREPORT "libraries@haskell.org" @@ -585,6 +585,9 @@  /* Define to the version of this package. */ #define PACKAGE_VERSION "1.0"++/* The size of `struct MD5Context', as computed by sizeof. */+#define SIZEOF_STRUCT_MD5CONTEXT 88  /* Define to 1 if you have the ANSI C header files. */ #define STDC_HEADERS 1
include/Typeable.h view
@@ -14,52 +14,26 @@ #ifndef TYPEABLE_H #define TYPEABLE_H -#define INSTANCE_TYPEABLE0(tycon,tcname,str) \-tcname :: TyCon; \-tcname = mkTyCon str; \-instance Typeable tycon where { typeOf _ = mkTyConApp tcname [] }- #ifdef __GLASGOW_HASKELL__ ---  // For GHC, the extra instances follow from general instance declarations---  // defined in Data.Typeable.--#define INSTANCE_TYPEABLE1(tycon,tcname,str) \-tcname :: TyCon; \-tcname = mkTyCon str; \-instance Typeable1 tycon where { typeOf1 _ = mkTyConApp tcname [] }--#define INSTANCE_TYPEABLE2(tycon,tcname,str) \-tcname :: TyCon; \-tcname = mkTyCon str; \-instance Typeable2 tycon where { typeOf2 _ = mkTyConApp tcname [] }--#define INSTANCE_TYPEABLE3(tycon,tcname,str) \-tcname :: TyCon; \-tcname = mkTyCon str; \-instance Typeable3 tycon where { typeOf3 _ = mkTyConApp tcname [] }--#define INSTANCE_TYPEABLE4(tycon,tcname,str) \-tcname :: TyCon; \-tcname = mkTyCon str; \-instance Typeable4 tycon where { typeOf4 _ = mkTyConApp tcname [] }+--  // For GHC, we can use DeriveDataTypeable + StandaloneDeriving to+--  // generate the instances. -#define INSTANCE_TYPEABLE5(tycon,tcname,str) \-tcname :: TyCon; \-tcname = mkTyCon str; \-instance Typeable5 tycon where { typeOf5 _ = mkTyConApp tcname [] }+#define INSTANCE_TYPEABLE0(tycon,tcname,str) deriving instance Typeable tycon+#define INSTANCE_TYPEABLE1(tycon,tcname,str) deriving instance Typeable1 tycon+#define INSTANCE_TYPEABLE2(tycon,tcname,str) deriving instance Typeable2 tycon+#define INSTANCE_TYPEABLE3(tycon,tcname,str) deriving instance Typeable3 tycon+#define INSTANCE_TYPEABLE4(tycon,tcname,str) deriving instance Typeable4 tycon+#define INSTANCE_TYPEABLE5(tycon,tcname,str) deriving instance Typeable5 tycon+#define INSTANCE_TYPEABLE6(tycon,tcname,str) deriving instance Typeable6 tycon+#define INSTANCE_TYPEABLE7(tycon,tcname,str) deriving instance Typeable7 tycon -#define INSTANCE_TYPEABLE6(tycon,tcname,str) \-tcname :: TyCon; \-tcname = mkTyCon str; \-instance Typeable6 tycon where { typeOf6 _ = mkTyConApp tcname [] }+#else /* !__GLASGOW_HASKELL__ */ -#define INSTANCE_TYPEABLE7(tycon,tcname,str) \+#define INSTANCE_TYPEABLE0(tycon,tcname,str) \ tcname :: TyCon; \ tcname = mkTyCon str; \-instance Typeable7 tycon where { typeOf7 _ = mkTyConApp tcname [] }--#else /* !__GLASGOW_HASKELL__ */+instance Typeable tycon where { typeOf _ = mkTyConApp tcname [] }  #define INSTANCE_TYPEABLE1(tycon,tcname,str) \ tcname = mkTyCon str; \
+ include/md5.h view
@@ -0,0 +1,24 @@+/* MD5 message digest */+#ifndef _MD5_H+#define _MD5_H++#include "HsFFI.h"++typedef HsWord32 word32;+typedef HsWord8  byte;++struct MD5Context {+	word32 buf[4];+	word32 bytes[2];+	word32 in[16];+};++void MD5Init(struct MD5Context *context);+void MD5Update(struct MD5Context *context, byte const *buf, int len);+void MD5Final(byte digest[16], struct MD5Context *context);+void MD5Transform(word32 buf[4], word32 const in[16]);++#endif /* _MD5_H */+++